These are the sources of the protocol of Tezos imported to Coq by the current development version of coq-of-ocaml. Tezos is a crypto-currency with smart-contracts and an upgradable protocol.
We show the original OCaml code on the left and the imported Coq code on the right. The imported code does not compile. Errors reported on the OCaml side are due to either various incompleteness in our tool, or to side-effects in the source code. Write at web [at] clarus [dot] me for more information. Work currently made at Nomadic Labs.
alpha_context.ml 2 errors
(*****************************************************************************)
(* *)
(* Open Source License *)
(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com> *)
(* *)
(* Permission is hereby granted, free of charge, to any person obtaining a *)
(* copy of this software and associated documentation files (the "Software"),*)
(* to deal in the Software without restriction, including without limitation *)
(* the rights to use, copy, modify, merge, publish, distribute, sublicense, *)
(* and/or sell copies of the Software, and to permit persons to whom the *)
(* Software is furnished to do so, subject to the following conditions: *)
(* *)
(* The above copyright notice and this permission notice shall be included *)
(* in all copies or substantial portions of the Software. *)
(* *)
(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*)
(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, *)
(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL *)
(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*)
(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING *)
(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER *)
(* DEALINGS IN THE SOFTWARE. *)
(* *)
(*****************************************************************************)
type t = Raw_context.t
type context = t
module type BASIC_DATA = sig
type t
include Compare.S with type t := t
val encoding : t Data_encoding.t
val pp : Format.formatter -> t -> unit
end
module Tez = Tez_repr
module Period = Period_repr
module Timestamp = struct
include Time_repr
let current = Raw_context.current_timestamp
end
include Operation_repr
module Operation = struct
type 'kind t = 'kind operation = {
shell : Operation.shell_header;
protocol_data : 'kind protocol_data;
}
type packed = packed_operation
let unsigned_encoding = unsigned_operation_encoding
include Operation_repr
end
module Block_header = Block_header_repr
module Vote = struct
include Vote_repr
include Vote_storage
end
module Raw_level = Raw_level_repr
module Cycle = Cycle_repr
module Script_int = Script_int_repr
module Script_timestamp = struct
include Script_timestamp_repr
let now ctxt =
let {Constants_repr.time_between_blocks; _} = Raw_context.constants ctxt in
match time_between_blocks with
| [] ->
failwith
"Internal error: 'time_between_block' constants is an empty list."
| first_delay :: _ ->
let current_timestamp = Raw_context.predecessor_timestamp ctxt in
Time.add current_timestamp (Period_repr.to_seconds first_delay)
|> Timestamp.to_seconds |> of_int64
end
module Script = struct
include Michelson_v1_primitives
include Script_repr
let force_decode ctxt lexpr =
Lwt.return
( Script_repr.force_decode lexpr
>>? fun (v, cost) ->
Raw_context.consume_gas ctxt cost >|? fun ctxt -> (v, ctxt) )
let force_bytes ctxt lexpr =
Lwt.return
( Script_repr.force_bytes lexpr
>>? fun (b, cost) ->
Raw_context.consume_gas ctxt cost >|? fun ctxt -> (b, ctxt) )
module Legacy_support = Legacy_script_support_repr
end
module Fees = Fees_storage
type public_key = Signature.Public_key.t
type public_key_hash = Signature.Public_key_hash.t
type signature = Signature.t
module Constants = struct
include Constants_repr
include Constants_storage
end
module Voting_period = Voting_period_repr
module Gas = struct
include Gas_limit_repr
type error += Gas_limit_too_high = Raw_context.Gas_limit_too_high
let check_limit = Raw_context.check_gas_limit
let set_limit = Raw_context.set_gas_limit
let set_unlimited = Raw_context.set_gas_unlimited
let consume = Raw_context.consume_gas
let check_enough = Raw_context.check_enough_gas
let level = Raw_context.gas_level
let consumed = Raw_context.gas_consumed
let block_level = Raw_context.block_gas_level
end
module Level = struct
include Level_repr
include Level_storage
end
module Contract = struct
include Contract_repr
include Contract_storage
let originate c contract ~balance ~script ~delegate =
originate c contract ~balance ~script ~delegate
let init_origination_nonce = Raw_context.init_origination_nonce
let unset_origination_nonce = Raw_context.unset_origination_nonce
end
module Big_map = struct
type id = Z.t
let fresh = Storage.Big_map.Next.incr
let fresh_temporary = Raw_context.fresh_temporary_big_map
let mem c m k = Storage.Big_map.Contents.mem (c, m) k
let get_opt c m k = Storage.Big_map.Contents.get_option (c, m) k
let rpc_arg = Storage.Big_map.rpc_arg
let cleanup_temporary c =
Raw_context.temporary_big_maps c Storage.Big_map.remove_rec c
>>= fun c -> Lwt.return (Raw_context.reset_temporary_big_map c)
let exists c id =
Lwt.return
(Raw_context.consume_gas c (Gas_limit_repr.read_bytes_cost Z.zero))
>>=? fun c ->
Storage.Big_map.Key_type.get_option c id
>>=? fun kt ->
match kt with
| None ->
return (c, None)
| Some kt ->
Storage.Big_map.Value_type.get c id
>>=? fun kv -> return (c, Some (kt, kv))
end
module Delegate = Delegate_storage
module Roll = struct
include Roll_repr
include Roll_storage
end
module Nonce = Nonce_storage
module Seed = struct
include Seed_repr
include Seed_storage
end
module Fitness = struct
include Fitness_repr
include Fitness
type fitness = t
include Fitness_storage
end
module Bootstrap = Bootstrap_storage
module Commitment = struct
include Commitment_repr
include Commitment_storage
end
module Global = struct
let get_block_priority = Storage.Block_priority.get
let set_block_priority = Storage.Block_priority.set
end
let prepare_first_block = Init_storage.prepare_first_block
let prepare = Init_storage.prepare
let finalize ?commit_message:message c =
let fitness = Fitness.from_int64 (Fitness.current c) in
let context = Raw_context.recover c in
{
Updater.context;
fitness;
message;
max_operations_ttl = 60;
last_allowed_fork_level =
Raw_level.to_int32 @@ Level.last_allowed_fork_level c;
}
let activate = Raw_context.activate
let fork_test_chain = Raw_context.fork_test_chain
let record_endorsement = Raw_context.record_endorsement
let allowed_endorsements = Raw_context.allowed_endorsements
let init_endorsements = Raw_context.init_endorsements
let included_endorsements = Raw_context.included_endorsements
let reset_internal_nonce = Raw_context.reset_internal_nonce
let fresh_internal_nonce = Raw_context.fresh_internal_nonce
let record_internal_nonce = Raw_context.record_internal_nonce
let internal_nonce_already_recorded =
Raw_context.internal_nonce_already_recorded
let add_deposit = Raw_context.add_deposit
let add_fees = Raw_context.add_fees
let add_rewards = Raw_context.add_rewards
let get_deposits = Raw_context.get_deposits
let get_fees = Raw_context.get_fees
let get_rewards = Raw_context.get_rewards
let description = Raw_context.description
alpha_context_ml.v
Require Import OCaml.OCaml.
Local Open Scope Z_scope.
Local Open Scope type_scope.
Import ListNotations.
Definition t := Tezos_raw_protocol_alpha.Raw_context.t.
Definition context := t.
Module BASIC_DATA.
Record signature {t : Set} := {
t := t;
op_eq : t -> t -> bool;
op_ltgt : t -> t -> bool;
op_lt : t -> t -> bool;
op_lteq : t -> t -> bool;
op_gteq : t -> t -> bool;
op_gt : t -> t -> bool;
compare : t -> t -> Z;
equal : t -> t -> bool;
max : t -> t -> t;
min : t -> t -> t;
encoding : Tezos_protocol_environment_alpha__Environment.Data_encoding.t t;
pp :
Tezos_protocol_environment_alpha__Environment.Format.formatter -> t ->
unit;
}.
Arguments signature : clear implicits.
End BASIC_DATA.
Module Tez := Tez_repr.
Module Period := Period_repr.
Module Timestamp.
Export Time_repr.
Definition current
: Tezos_raw_protocol_alpha.Raw_context.context ->
Tezos_protocol_environment_alpha__Environment.Time.t :=
Raw_context.current_timestamp.
End Timestamp.
Export Operation_repr.
Module Operation.
Module t.
Record record {kind : Set} := {
shell :
Tezos_protocol_environment_alpha__Environment.Operation.shell_header;
protocol_data : protocol_data kind }.
Arguments record : clear implicits.
End t.
Definition t := t.record.
Definition packed := packed_operation.
Definition unsigned_encoding
: Tezos_protocol_environment_alpha__Environment.Data_encoding.t
(Tezos_protocol_environment_alpha__Environment.Operation.shell_header *
packed_contents_list) := unsigned_operation_encoding.
Export Operation_repr.
End Operation.
Module Block_header := Block_header_repr.
Module Vote.
Export Vote_repr.
Export Vote_storage.
End Vote.
Module Raw_level := Raw_level_repr.
Module Cycle := Cycle_repr.
Module Script_int := Script_int_repr.
Module Script_timestamp.
Export Script_timestamp_repr.
Definition now (ctxt : Tezos_raw_protocol_alpha.Raw_context.context) : t :=
let '{|
Tezos_raw_protocol_alpha.Constants_repr.parametric.time_between_blocks :=
time_between_blocks
|} := Raw_context.constants ctxt in
match time_between_blocks with
| [] =>
failwith
"Internal error: 'time_between_block' constants is an empty list." %
string
| cons first_delay _ =>
let current_timestamp := Raw_context.predecessor_timestamp ctxt in
op_pipegt
(op_pipegt
(Time.add current_timestamp (Period_repr.to_seconds first_delay))
Timestamp.to_seconds) of_int64
end.
End Script_timestamp.
Module Script.
Export Michelson_v1_primitives.
Export Script_repr.
Definition force_decode
(ctxt : Tezos_raw_protocol_alpha.Raw_context.context)
(lexpr : Tezos_raw_protocol_alpha.Script_repr.lazy_expr)
: Tezos_protocol_environment_alpha__Environment.Lwt.t
(Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
(Tezos_raw_protocol_alpha.Script_repr.expr *
Tezos_raw_protocol_alpha.Raw_context.context)) :=
Lwt.__return
(op_gtgtquestion (Script_repr.force_decode lexpr)
(fun function_parameter =>
let '(v, cost) := function_parameter in
op_gtpipequestion (Raw_context.consume_gas ctxt cost)
(fun ctxt => (v, ctxt)))).
Definition force_bytes
(ctxt : Tezos_raw_protocol_alpha.Raw_context.context)
(lexpr : Tezos_raw_protocol_alpha.Script_repr.lazy_expr)
: Tezos_protocol_environment_alpha__Environment.Lwt.t
(Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
(Tezos_protocol_environment_alpha__Environment.MBytes.t *
Tezos_raw_protocol_alpha.Raw_context.context)) :=
Lwt.__return
(op_gtgtquestion (Script_repr.force_bytes lexpr)
(fun function_parameter =>
let '(b, cost) := function_parameter in
op_gtpipequestion (Raw_context.consume_gas ctxt cost)
(fun ctxt => (b, ctxt)))).
Module Legacy_support := Legacy_script_support_repr.
End Script.
Module Fees := Fees_storage.
Definition public_key :=
Tezos_protocol_environment_alpha__Environment.Signature.Public_key.t.
Definition public_key_hash :=
Tezos_protocol_environment_alpha__Environment.Signature.Public_key_hash.t.
Definition signature :=
Tezos_protocol_environment_alpha__Environment.Signature.t.
Module Constants.
Export Constants_repr.
Export Constants_storage.
End Constants.
Module Voting_period := Voting_period_repr.
Module Gas.
Export Gas_limit_repr.
(* ❌ Structure item `typext` not handled. *)
type_extension
Definition check_limit
: Tezos_raw_protocol_alpha.Raw_context.t ->
Tezos_protocol_environment_alpha__Environment.Z.t ->
Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult unit :=
Raw_context.check_gas_limit.
Definition set_limit
: Tezos_raw_protocol_alpha.Raw_context.t ->
Tezos_protocol_environment_alpha__Environment.Z.t ->
Tezos_raw_protocol_alpha.Raw_context.t := Raw_context.set_gas_limit.
Definition set_unlimited
: Tezos_raw_protocol_alpha.Raw_context.t ->
Tezos_raw_protocol_alpha.Raw_context.t := Raw_context.set_gas_unlimited.
Definition consume
: Tezos_raw_protocol_alpha.Raw_context.context ->
Tezos_raw_protocol_alpha.Gas_limit_repr.cost ->
Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
Tezos_raw_protocol_alpha.Raw_context.context := Raw_context.consume_gas.
Definition check_enough
: Tezos_raw_protocol_alpha.Raw_context.context ->
Tezos_raw_protocol_alpha.Gas_limit_repr.cost ->
Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult unit :=
Raw_context.check_enough_gas.
Definition level
: Tezos_raw_protocol_alpha.Raw_context.t ->
Tezos_raw_protocol_alpha.Gas_limit_repr.t := Raw_context.gas_level.
Definition consumed
: Tezos_raw_protocol_alpha.Raw_context.t ->
Tezos_raw_protocol_alpha.Raw_context.t ->
Tezos_protocol_environment_alpha__Environment.Z.t :=
Raw_context.gas_consumed.
Definition block_level
: Tezos_raw_protocol_alpha.Raw_context.t ->
Tezos_protocol_environment_alpha__Environment.Z.t :=
Raw_context.block_gas_level.
End Gas.
Module Level.
Export Level_repr.
Export Level_storage.
End Level.
Module Contract.
Export Contract_repr.
Export Contract_storage.
Definition originate
(c : Tezos_raw_protocol_alpha.Raw_context.t)
(contract : Tezos_raw_protocol_alpha.Contract_repr.t)
(balance : Tezos_raw_protocol_alpha.Tez_repr.t)
(script : Tezos_raw_protocol_alpha.Script_repr.t * option big_map_diff)
(delegate :
option
Tezos_protocol_environment_alpha__Environment.Signature.Public_key_hash.t)
: Tezos_protocol_environment_alpha__Environment.Lwt.t
(Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
Tezos_raw_protocol_alpha.Raw_context.t) :=
originate c None contract balance script delegate.
Definition init_origination_nonce
: Tezos_raw_protocol_alpha.Raw_context.t ->
Tezos_protocol_environment_alpha__Environment.Operation_hash.t ->
Tezos_raw_protocol_alpha.Raw_context.t := Raw_context.init_origination_nonce.
Definition unset_origination_nonce
: Tezos_raw_protocol_alpha.Raw_context.t ->
Tezos_raw_protocol_alpha.Raw_context.t :=
Raw_context.unset_origination_nonce.
End Contract.
Module Big_map.
Definition id := Tezos_protocol_environment_alpha__Environment.Z.t.
Definition fresh
: Tezos_raw_protocol_alpha.Raw_context.t ->
Tezos_protocol_environment_alpha__Environment.Lwt.t
(Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
(Tezos_raw_protocol_alpha.Raw_context.t *
Tezos_protocol_environment_alpha__Environment.Z.t)) :=
Storage.Big_map.Next.incr.
Definition fresh_temporary
: Tezos_raw_protocol_alpha.Raw_context.context ->
Tezos_raw_protocol_alpha.Raw_context.context *
Tezos_protocol_environment_alpha__Environment.Z.t :=
Raw_context.fresh_temporary_big_map.
Definition mem
(c : Tezos_raw_protocol_alpha.Raw_context.t)
(m : Tezos_protocol_environment_alpha__Environment.Z.t)
(k : Tezos_raw_protocol_alpha.Storage.Big_map.Contents.key)
: Tezos_protocol_environment_alpha__Environment.Lwt.t
(Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
(Tezos_raw_protocol_alpha.Raw_context.t * bool)) :=
Storage.Big_map.Contents.mem (c, m) k.
Definition get_opt
(c : Tezos_raw_protocol_alpha.Raw_context.t)
(m : Tezos_protocol_environment_alpha__Environment.Z.t)
(k : Tezos_raw_protocol_alpha.Storage.Big_map.Contents.key)
: Tezos_protocol_environment_alpha__Environment.Lwt.t
(Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
(Tezos_raw_protocol_alpha.Raw_context.t *
option Tezos_raw_protocol_alpha.Storage.Big_map.Contents.value)) :=
Storage.Big_map.Contents.get_option (c, m) k.
Definition rpc_arg
: Tezos_protocol_environment_alpha__Environment.RPC_arg.t
Tezos_protocol_environment_alpha__Environment.Z.t :=
Storage.Big_map.rpc_arg.
Definition cleanup_temporary
(c : Tezos_raw_protocol_alpha.Raw_context.context)
: Tezos_protocol_environment_alpha__Environment.Lwt.t
Tezos_raw_protocol_alpha.Raw_context.context :=
op_gtgteq (Raw_context.temporary_big_maps c Storage.Big_map.remove_rec c)
(fun c => Lwt.__return (Raw_context.reset_temporary_big_map c)).
Definition __exists
(c : Tezos_raw_protocol_alpha.Raw_context.context)
(id : Tezos_raw_protocol_alpha.Storage.Big_map.Key_type.key)
: Tezos_protocol_environment_alpha__Environment.Lwt.t
(Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
(Tezos_raw_protocol_alpha.Raw_context.context *
option
(Tezos_raw_protocol_alpha.Storage.Big_map.Key_type.value *
Tezos_raw_protocol_alpha.Storage.Big_map.Value_type.value))) :=
op_gtgteqquestion
(Lwt.__return
(Raw_context.consume_gas c (Gas_limit_repr.read_bytes_cost Z.zero)))
(fun c =>
op_gtgteqquestion (Storage.Big_map.Key_type.get_option c id)
(fun kt =>
match kt with
| None => __return (c, None)
| Some kt =>
op_gtgteqquestion (Storage.Big_map.Value_type.get c id)
(fun kv => __return (c, (Some (kt, kv))))
end)).
End Big_map.
Module Delegate := Delegate_storage.
Module Roll.
Export Roll_repr.
Export Roll_storage.
End Roll.
Module Nonce := Nonce_storage.
Module Seed.
Export Seed_repr.
Export Seed_storage.
End Seed.
Module Fitness.
Export Fitness_repr.
Export Fitness.
Definition fitness := t.
Export Fitness_storage.
End Fitness.
Module Bootstrap := Bootstrap_storage.
Module Commitment.
Export Commitment_repr.
Export Commitment_storage.
End Commitment.
Module Global.
Definition get_block_priority
: Tezos_raw_protocol_alpha.Raw_context.t ->
Tezos_protocol_environment_alpha__Environment.Lwt.t
(Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult Z) :=
Storage.Block_priority.get.
Definition set_block_priority
: Tezos_raw_protocol_alpha.Raw_context.t -> Z ->
Tezos_protocol_environment_alpha__Environment.Lwt.t
(Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
Tezos_raw_protocol_alpha.Raw_context.t) := Storage.Block_priority.set.
End Global.
Definition prepare_first_block
: Tezos_protocol_environment_alpha__Environment.Context.t ->
(Tezos_raw_protocol_alpha.Raw_context.t ->
Tezos_raw_protocol_alpha.Script_repr.t ->
Tezos_protocol_environment_alpha__Environment.Lwt.t
(Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
((Tezos_raw_protocol_alpha.Script_repr.t *
option Tezos_raw_protocol_alpha.Contract_storage.big_map_diff) *
Tezos_raw_protocol_alpha.Raw_context.t))) -> int32 ->
Tezos_protocol_environment_alpha__Environment.Time.t ->
Tezos_protocol_environment_alpha__Environment.Fitness.t ->
Tezos_protocol_environment_alpha__Environment.Lwt.t
(Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
Tezos_raw_protocol_alpha.Raw_context.t) :=
Init_storage.prepare_first_block.
Definition prepare
: Tezos_protocol_environment_alpha__Environment.Context.t ->
Tezos_protocol_environment_alpha__Environment.Int32.t ->
Tezos_protocol_environment_alpha__Environment.Time.t ->
Tezos_protocol_environment_alpha__Environment.Time.t ->
Tezos_protocol_environment_alpha__Environment.Fitness.t ->
Tezos_protocol_environment_alpha__Environment.Lwt.t
(Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
Tezos_raw_protocol_alpha.Raw_context.context) := Init_storage.prepare.
Definition finalize
(message : option string) (c : Tezos_raw_protocol_alpha.Raw_context.context)
: Tezos_protocol_environment_alpha__Environment.Updater.validation_result :=
let fitness := Fitness.from_int64 (Fitness.current c) in
let context := Raw_context.recover c in
{|
Tezos_protocol_environment_alpha__Environment.Updater.validation_result.context :=
context;
Tezos_protocol_environment_alpha__Environment.Updater.validation_result.fitness :=
fitness;
Tezos_protocol_environment_alpha__Environment.Updater.validation_result.message :=
message;
Tezos_protocol_environment_alpha__Environment.Updater.validation_result.max_operations_ttl :=
60;
Tezos_protocol_environment_alpha__Environment.Updater.validation_result.last_allowed_fork_level :=
op_atat Raw_level.to_int32 (Level.last_allowed_fork_level c) |}.
Definition activate
: Tezos_raw_protocol_alpha.Raw_context.context ->
Tezos_protocol_environment_alpha__Environment.Protocol_hash.t ->
Tezos_protocol_environment_alpha__Environment.Lwt.t
Tezos_raw_protocol_alpha.Raw_context.t := Raw_context.activate.
Definition fork_test_chain
: Tezos_raw_protocol_alpha.Raw_context.context ->
Tezos_protocol_environment_alpha__Environment.Protocol_hash.t ->
Tezos_protocol_environment_alpha__Environment.Time.t ->
Tezos_protocol_environment_alpha__Environment.Lwt.t
Tezos_raw_protocol_alpha.Raw_context.t := Raw_context.fork_test_chain.
Definition record_endorsement
: Tezos_raw_protocol_alpha.Raw_context.context ->
Tezos_protocol_environment_alpha__Environment.Signature.Public_key_hash.t ->
Tezos_raw_protocol_alpha.Raw_context.context := Raw_context.record_endorsement.
Definition allowed_endorsements
: Tezos_raw_protocol_alpha.Raw_context.context ->
Tezos_protocol_environment_alpha__Environment.Signature.Public_key_hash.Map.t
(Tezos_protocol_environment_alpha__Environment.Signature.Public_key.t *
list Z * bool) := Raw_context.allowed_endorsements.
Definition init_endorsements
: Tezos_raw_protocol_alpha.Raw_context.context ->
Tezos_protocol_environment_alpha__Environment.Signature.Public_key_hash.Map.t
(Tezos_protocol_environment_alpha__Environment.Signature.Public_key.t *
list Z * bool) -> Tezos_raw_protocol_alpha.Raw_context.context :=
Raw_context.init_endorsements.
Definition included_endorsements
: Tezos_raw_protocol_alpha.Raw_context.context -> Z :=
Raw_context.included_endorsements.
Definition reset_internal_nonce
: Tezos_raw_protocol_alpha.Raw_context.context ->
Tezos_raw_protocol_alpha.Raw_context.context :=
Raw_context.reset_internal_nonce.
Definition fresh_internal_nonce
: Tezos_raw_protocol_alpha.Raw_context.context ->
Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
(Tezos_raw_protocol_alpha.Raw_context.context * Z) :=
Raw_context.fresh_internal_nonce.
Definition record_internal_nonce
: Tezos_raw_protocol_alpha.Raw_context.context -> Z ->
Tezos_raw_protocol_alpha.Raw_context.context :=
Raw_context.record_internal_nonce.
Definition internal_nonce_already_recorded
: Tezos_raw_protocol_alpha.Raw_context.context -> Z -> bool :=
Raw_context.internal_nonce_already_recorded.
Definition add_deposit
: Tezos_raw_protocol_alpha.Raw_context.context ->
Tezos_protocol_environment_alpha__Environment.Signature.Public_key_hash.t ->
Tezos_raw_protocol_alpha.Tez_repr.t ->
Tezos_protocol_environment_alpha__Environment.Lwt.t
(Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
Tezos_raw_protocol_alpha.Raw_context.context) := Raw_context.add_deposit.
Definition add_fees
: Tezos_raw_protocol_alpha.Raw_context.context ->
Tezos_raw_protocol_alpha.Tez_repr.t ->
Tezos_protocol_environment_alpha__Environment.Lwt.t
(Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
Tezos_raw_protocol_alpha.Raw_context.context) := Raw_context.add_fees.
Definition add_rewards
: Tezos_raw_protocol_alpha.Raw_context.context ->
Tezos_raw_protocol_alpha.Tez_repr.t ->
Tezos_protocol_environment_alpha__Environment.Lwt.t
(Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
Tezos_raw_protocol_alpha.Raw_context.context) := Raw_context.add_rewards.
Definition get_deposits
: Tezos_raw_protocol_alpha.Raw_context.context ->
Tezos_protocol_environment_alpha__Environment.Signature.Public_key_hash.Map.t
Tezos_raw_protocol_alpha.Tez_repr.t := Raw_context.get_deposits.
Definition get_fees
: Tezos_raw_protocol_alpha.Raw_context.context ->
Tezos_raw_protocol_alpha.Tez_repr.t := Raw_context.get_fees.
Definition get_rewards
: Tezos_raw_protocol_alpha.Raw_context.context ->
Tezos_raw_protocol_alpha.Tez_repr.t := Raw_context.get_rewards.
Definition description
: Tezos_raw_protocol_alpha.Storage_description.t
Tezos_raw_protocol_alpha.Raw_context.context := Raw_context.description.
alpha_context.mli 26 errors
(*****************************************************************************)
(* *)
(* Open Source License *)
(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com> *)
(* *)
(* Permission is hereby granted, free of charge, to any person obtaining a *)
(* copy of this software and associated documentation files (the "Software"),*)
(* to deal in the Software without restriction, including without limitation *)
(* the rights to use, copy, modify, merge, publish, distribute, sublicense, *)
(* and/or sell copies of the Software, and to permit persons to whom the *)
(* Software is furnished to do so, subject to the following conditions: *)
(* *)
(* The above copyright notice and this permission notice shall be included *)
(* in all copies or substantial portions of the Software. *)
(* *)
(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*)
(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, *)
(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL *)
(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*)
(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING *)
(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER *)
(* DEALINGS IN THE SOFTWARE. *)
(* *)
(*****************************************************************************)
module type BASIC_DATA = sig
type t
include Compare.S with type t := t
val encoding : t Data_encoding.t
val pp : Format.formatter -> t -> unit
end
type t
type context = t
type public_key = Signature.Public_key.t
type public_key_hash = Signature.Public_key_hash.t
type signature = Signature.t
module Tez : sig
include BASIC_DATA
type tez = t
val zero : tez
val one_mutez : tez
val one_cent : tez
val fifty_cents : tez
val one : tez
val ( -? ) : tez -> tez -> tez tzresult
val ( +? ) : tez -> tez -> tez tzresult
val ( *? ) : tez -> int64 -> tez tzresult
val ( /? ) : tez -> int64 -> tez tzresult
val of_string : string -> tez option
val to_string : tez -> string
val of_mutez : int64 -> tez option
val to_mutez : tez -> int64
end
module Period : sig
include BASIC_DATA
type period = t
val rpc_arg : period RPC_arg.arg
val of_seconds : int64 -> period tzresult
val to_seconds : period -> int64
val mult : int32 -> period -> period tzresult
val zero : period
val one_second : period
val one_minute : period
val one_hour : period
end
module Timestamp : sig
include BASIC_DATA with type t = Time.t
type time = t
val ( +? ) : time -> Period.t -> time tzresult
val ( -? ) : time -> time -> Period.t tzresult
val of_notation : string -> time option
val to_notation : time -> string
val of_seconds : string -> time option
val to_seconds_string : time -> string
val current : context -> time
end
module Raw_level : sig
include BASIC_DATA
type raw_level = t
val rpc_arg : raw_level RPC_arg.arg
val diff : raw_level -> raw_level -> int32
val root : raw_level
val succ : raw_level -> raw_level
val pred : raw_level -> raw_level option
val to_int32 : raw_level -> int32
val of_int32 : int32 -> raw_level tzresult
end
module Cycle : sig
include BASIC_DATA
type cycle = t
val rpc_arg : cycle RPC_arg.arg
val root : cycle
val succ : cycle -> cycle
val pred : cycle -> cycle option
val add : cycle -> int -> cycle
val sub : cycle -> int -> cycle option
val to_int32 : cycle -> int32
module Map : S.MAP with type key = cycle
end
module Gas : sig
type t = private Unaccounted | Limited of {remaining : Z.t}
val encoding : t Data_encoding.encoding
val pp : Format.formatter -> t -> unit
type cost
val cost_encoding : cost Data_encoding.encoding
val pp_cost : Format.formatter -> cost -> unit
type error += Block_quota_exceeded (* `Temporary *)
type error += Operation_quota_exceeded (* `Temporary *)
type error += Gas_limit_too_high (* `Permanent *)
val free : cost
val atomic_step_cost : int -> cost
val step_cost : int -> cost
val alloc_cost : int -> cost
val alloc_bytes_cost : int -> cost
val alloc_mbytes_cost : int -> cost
val alloc_bits_cost : int -> cost
val read_bytes_cost : Z.t -> cost
val write_bytes_cost : Z.t -> cost
val ( *@ ) : int -> cost -> cost
val ( +@ ) : cost -> cost -> cost
val check_limit : context -> Z.t -> unit tzresult
val set_limit : context -> Z.t -> context
val set_unlimited : context -> context
val consume : context -> cost -> context tzresult
val check_enough : context -> cost -> unit tzresult
val level : context -> t
val consumed : since:context -> until:context -> Z.t
val block_level : context -> Z.t
end
module Script_int : module type of Script_int_repr
module Script_timestamp : sig
open Script_int
type t
val compare : t -> t -> int
val to_string : t -> string
val to_notation : t -> string option
val to_num_str : t -> string
val of_string : string -> t option
val diff : t -> t -> z num
val add_delta : t -> z num -> t
val sub_delta : t -> z num -> t
val now : context -> t
val to_zint : t -> Z.t
val of_zint : Z.t -> t
end
module Script : sig
type prim = Michelson_v1_primitives.prim =
| K_parameter
| K_storage
| K_code
| D_False
| D_Elt
| D_Left
| D_None
| D_Pair
| D_Right
| D_Some
| D_True
| D_Unit
| I_PACK
| I_UNPACK
| I_BLAKE2B
| I_SHA256
| I_SHA512
| I_ABS
| I_ADD
| I_AMOUNT
| I_AND
| I_BALANCE
| I_CAR
| I_CDR
| I_CHAIN_ID
| I_CHECK_SIGNATURE
| I_COMPARE
| I_CONCAT
| I_CONS
| I_CREATE_ACCOUNT
| I_CREATE_CONTRACT
| I_IMPLICIT_ACCOUNT
| I_DIP
| I_DROP
| I_DUP
| I_EDIV
| I_EMPTY_BIG_MAP
| I_EMPTY_MAP
| I_EMPTY_SET
| I_EQ
| I_EXEC
| I_APPLY
| I_FAILWITH
| I_GE
| I_GET
| I_GT
| I_HASH_KEY
| I_IF
| I_IF_CONS
| I_IF_LEFT
| I_IF_NONE
| I_INT
| I_LAMBDA
| I_LE
| I_LEFT
| I_LOOP
| I_LSL
| I_LSR
| I_LT
| I_MAP
| I_MEM
| I_MUL
| I_NEG
| I_NEQ
| I_NIL
| I_NONE
| I_NOT
| I_NOW
| I_OR
| I_PAIR
| I_PUSH
| I_RIGHT
| I_SIZE
| I_SOME
| I_SOURCE
| I_SENDER
| I_SELF
| I_SLICE
| I_STEPS_TO_QUOTA
| I_SUB
| I_SWAP
| I_TRANSFER_TOKENS
| I_SET_DELEGATE
| I_UNIT
| I_UPDATE
| I_XOR
| I_ITER
| I_LOOP_LEFT
| I_ADDRESS
| I_CONTRACT
| I_ISNAT
| I_CAST
| I_RENAME
| I_DIG
| I_DUG
| T_bool
| T_contract
| T_int
| T_key
| T_key_hash
| T_lambda
| T_list
| T_map
| T_big_map
| T_nat
| T_option
| T_or
| T_pair
| T_set
| T_signature
| T_string
| T_bytes
| T_mutez
| T_timestamp
| T_unit
| T_operation
| T_address
| T_chain_id
type location = Micheline.canonical_location
type annot = Micheline.annot
type expr = prim Micheline.canonical
type lazy_expr = expr Data_encoding.lazy_t
val lazy_expr : expr -> lazy_expr
type node = (location, prim) Micheline.node
type t = {code : lazy_expr; storage : lazy_expr}
val location_encoding : location Data_encoding.t
val expr_encoding : expr Data_encoding.t
val prim_encoding : prim Data_encoding.t
val encoding : t Data_encoding.t
val lazy_expr_encoding : lazy_expr Data_encoding.t
val deserialized_cost : expr -> Gas.cost
val serialized_cost : MBytes.t -> Gas.cost
val traversal_cost : node -> Gas.cost
val node_cost : node -> Gas.cost
val int_node_cost : Z.t -> Gas.cost
val int_node_cost_of_numbits : int -> Gas.cost
val string_node_cost : string -> Gas.cost
val string_node_cost_of_length : int -> Gas.cost
val bytes_node_cost : MBytes.t -> Gas.cost
val bytes_node_cost_of_length : int -> Gas.cost
val prim_node_cost_nonrec : expr list -> annot -> Gas.cost
val prim_node_cost_nonrec_of_length : int -> annot -> Gas.cost
val seq_node_cost_nonrec : expr list -> Gas.cost
val seq_node_cost_nonrec_of_length : int -> Gas.cost
val minimal_deserialize_cost : lazy_expr -> Gas.cost
val force_decode : context -> lazy_expr -> (expr * context) tzresult Lwt.t
val force_bytes : context -> lazy_expr -> (MBytes.t * context) tzresult Lwt.t
val unit_parameter : lazy_expr
module Legacy_support : sig
val manager_script_code : lazy_expr
val add_do :
manager_pkh:Signature.Public_key_hash.t ->
script_code:lazy_expr ->
script_storage:lazy_expr ->
(lazy_expr * lazy_expr) tzresult Lwt.t
val add_set_delegate :
manager_pkh:Signature.Public_key_hash.t ->
script_code:lazy_expr ->
script_storage:lazy_expr ->
(lazy_expr * lazy_expr) tzresult Lwt.t
val has_default_entrypoint : lazy_expr -> bool
val add_root_entrypoint : script_code:lazy_expr -> lazy_expr tzresult Lwt.t
end
end
module Constants : sig
(** Fixed constants *)
type fixed = {
proof_of_work_nonce_size : int;
nonce_length : int;
max_revelations_per_block : int;
max_operation_data_length : int;
max_proposals_per_delegate : int;
}
val fixed_encoding : fixed Data_encoding.t
val fixed : fixed
val proof_of_work_nonce_size : int
val nonce_length : int
val max_revelations_per_block : int
val max_operation_data_length : int
val max_proposals_per_delegate : int
(** Constants parameterized by context *)
type parametric = {
preserved_cycles : int;
blocks_per_cycle : int32;
blocks_per_commitment : int32;
blocks_per_roll_snapshot : int32;
blocks_per_voting_period : int32;
time_between_blocks : Period.t list;
endorsers_per_block : int;
hard_gas_limit_per_operation : Z.t;
hard_gas_limit_per_block : Z.t;
proof_of_work_threshold : int64;
tokens_per_roll : Tez.t;
michelson_maximum_type_size : int;
seed_nonce_revelation_tip : Tez.t;
origination_size : int;
block_security_deposit : Tez.t;
endorsement_security_deposit : Tez.t;
block_reward : Tez.t;
endorsement_reward : Tez.t;
cost_per_byte : Tez.t;
hard_storage_limit_per_operation : Z.t;
test_chain_duration : int64;
quorum_min : int32;
quorum_max : int32;
min_proposal_quorum : int32;
initial_endorsers : int;
delay_per_missing_endorsement : Period.t;
}
val parametric_encoding : parametric Data_encoding.t
val parametric : context -> parametric
val preserved_cycles : context -> int
val blocks_per_cycle : context -> int32
val blocks_per_commitment : context -> int32
val blocks_per_roll_snapshot : context -> int32
val blocks_per_voting_period : context -> int32
val time_between_blocks : context -> Period.t list
val endorsers_per_block : context -> int
val initial_endorsers : context -> int
val delay_per_missing_endorsement : context -> Period.t
val hard_gas_limit_per_operation : context -> Z.t
val hard_gas_limit_per_block : context -> Z.t
val cost_per_byte : context -> Tez.t
val hard_storage_limit_per_operation : context -> Z.t
val proof_of_work_threshold : context -> int64
val tokens_per_roll : context -> Tez.t
val michelson_maximum_type_size : context -> int
val block_reward : context -> Tez.t
val endorsement_reward : context -> Tez.t
val seed_nonce_revelation_tip : context -> Tez.t
val origination_size : context -> int
val block_security_deposit : context -> Tez.t
val endorsement_security_deposit : context -> Tez.t
val test_chain_duration : context -> int64
val quorum_min : context -> int32
val quorum_max : context -> int32
val min_proposal_quorum : context -> int32
(** All constants: fixed and parametric *)
type t = {fixed : fixed; parametric : parametric}
val encoding : t Data_encoding.t
end
module Voting_period : sig
include BASIC_DATA
type voting_period = t
val rpc_arg : voting_period RPC_arg.arg
val root : voting_period
val succ : voting_period -> voting_period
type kind = Proposal | Testing_vote | Testing | Promotion_vote
val kind_encoding : kind Data_encoding.encoding
val to_int32 : voting_period -> int32
end
module Level : sig
type t = private {
level : Raw_level.t;
level_position : int32;
cycle : Cycle.t;
cycle_position : int32;
voting_period : Voting_period.t;
voting_period_position : int32;
expected_commitment : bool;
}
include BASIC_DATA with type t := t
val pp_full : Format.formatter -> t -> unit
type level = t
val root : context -> level
val succ : context -> level -> level
val pred : context -> level -> level option
val from_raw : context -> ?offset:int32 -> Raw_level.t -> level
val diff : level -> level -> int32
val current : context -> level
val last_level_in_cycle : context -> Cycle.t -> level
val levels_in_cycle : context -> Cycle.t -> level list
val levels_in_current_cycle : context -> ?offset:int32 -> unit -> level list
val last_allowed_fork_level : context -> Raw_level.t
end
module Fitness : sig
include module type of Fitness
type fitness = t
val increase : ?gap:int -> context -> context
val current : context -> int64
val to_int64 : fitness -> int64 tzresult
end
module Nonce : sig
type t
type nonce = t
val encoding : nonce Data_encoding.t
type unrevealed = {
nonce_hash : Nonce_hash.t;
delegate : public_key_hash;
rewards : Tez.t;
fees : Tez.t;
}
val record_hash : context -> unrevealed -> context tzresult Lwt.t
val reveal : context -> Level.t -> nonce -> context tzresult Lwt.t
type status = Unrevealed of unrevealed | Revealed of nonce
val get : context -> Level.t -> status tzresult Lwt.t
val of_bytes : MBytes.t -> nonce tzresult
val hash : nonce -> Nonce_hash.t
val check_hash : nonce -> Nonce_hash.t -> bool
end
module Seed : sig
type seed
type error +=
| Unknown of {oldest : Cycle.t; cycle : Cycle.t; latest : Cycle.t}
val for_cycle : context -> Cycle.t -> seed tzresult Lwt.t
val cycle_end :
context -> Cycle.t -> (context * Nonce.unrevealed list) tzresult Lwt.t
val seed_encoding : seed Data_encoding.t
end
module Big_map : sig
type id = Z.t
val fresh : context -> (context * id) tzresult Lwt.t
val fresh_temporary : context -> context * id
val mem :
context -> id -> Script_expr_hash.t -> (context * bool) tzresult Lwt.t
val get_opt :
context ->
id ->
Script_expr_hash.t ->
(context * Script.expr option) tzresult Lwt.t
val rpc_arg : id RPC_arg.t
val cleanup_temporary : context -> context Lwt.t
val exists :
context ->
id ->
(context * (Script.expr * Script.expr) option) tzresult Lwt.t
end
module Contract : sig
include BASIC_DATA
type contract = t
val rpc_arg : contract RPC_arg.arg
val to_b58check : contract -> string
val of_b58check : string -> contract tzresult
val implicit_contract : public_key_hash -> contract
val is_implicit : contract -> public_key_hash option
val exists : context -> contract -> bool tzresult Lwt.t
val must_exist : context -> contract -> unit tzresult Lwt.t
val allocated : context -> contract -> bool tzresult Lwt.t
val must_be_allocated : context -> contract -> unit tzresult Lwt.t
val list : context -> contract list Lwt.t
val get_manager_key : context -> public_key_hash -> public_key tzresult Lwt.t
val is_manager_key_revealed :
context -> public_key_hash -> bool tzresult Lwt.t
val reveal_manager_key :
context -> public_key_hash -> public_key -> context tzresult Lwt.t
val get_script_code :
context -> contract -> (context * Script.lazy_expr option) tzresult Lwt.t
val get_script :
context -> contract -> (context * Script.t option) tzresult Lwt.t
val get_storage :
context -> contract -> (context * Script.expr option) tzresult Lwt.t
val get_counter : context -> public_key_hash -> Z.t tzresult Lwt.t
val get_balance : context -> contract -> Tez.t tzresult Lwt.t
val init_origination_nonce : context -> Operation_hash.t -> context
val unset_origination_nonce : context -> context
val fresh_contract_from_current_nonce :
context -> (context * t) tzresult Lwt.t
val originated_from_current_nonce :
since:context -> until:context -> contract list tzresult Lwt.t
type big_map_diff_item =
| Update of {
big_map : Big_map.id;
diff_key : Script.expr;
diff_key_hash : Script_expr_hash.t;
diff_value : Script.expr option;
}
| Clear of Big_map.id
| Copy of Big_map.id * Big_map.id
| Alloc of {
big_map : Big_map.id;
key_type : Script.expr;
value_type : Script.expr;
}
type big_map_diff = big_map_diff_item list
val big_map_diff_encoding : big_map_diff Data_encoding.t
val originate :
context ->
contract ->
balance:Tez.t ->
script:Script.t * big_map_diff option ->
delegate:public_key_hash option ->
context tzresult Lwt.t
type error += Balance_too_low of contract * Tez.t * Tez.t
val spend : context -> contract -> Tez.t -> context tzresult Lwt.t
val credit : context -> contract -> Tez.t -> context tzresult Lwt.t
val update_script_storage :
context ->
contract ->
Script.expr ->
big_map_diff option ->
context tzresult Lwt.t
val used_storage_space : context -> t -> Z.t tzresult Lwt.t
val increment_counter : context -> public_key_hash -> context tzresult Lwt.t
val check_counter_increment :
context -> public_key_hash -> Z.t -> unit tzresult Lwt.t
(**/**)
(* Only for testing *)
type origination_nonce
val initial_origination_nonce : Operation_hash.t -> origination_nonce
val originated_contract : origination_nonce -> contract
end
module Delegate : sig
type balance =
| Contract of Contract.t
| Rewards of Signature.Public_key_hash.t * Cycle.t
| Fees of Signature.Public_key_hash.t * Cycle.t
| Deposits of Signature.Public_key_hash.t * Cycle.t
type balance_update = Debited of Tez.t | Credited of Tez.t
type balance_updates = (balance * balance_update) list
val balance_updates_encoding : balance_updates Data_encoding.t
val cleanup_balance_updates : balance_updates -> balance_updates
val get : context -> Contract.t -> public_key_hash option tzresult Lwt.t
val set :
context -> Contract.t -> public_key_hash option -> context tzresult Lwt.t
val fold :
context -> init:'a -> f:(public_key_hash -> 'a -> 'a Lwt.t) -> 'a Lwt.t
val list : context -> public_key_hash list Lwt.t
val freeze_deposit :
context -> public_key_hash -> Tez.t -> context tzresult Lwt.t
val freeze_rewards :
context -> public_key_hash -> Tez.t -> context tzresult Lwt.t
val freeze_fees :
context -> public_key_hash -> Tez.t -> context tzresult Lwt.t
val cycle_end :
context ->
Cycle.t ->
Nonce.unrevealed list ->
(context * balance_updates * Signature.Public_key_hash.t list) tzresult
Lwt.t
type frozen_balance = {deposit : Tez.t; fees : Tez.t; rewards : Tez.t}
val punish :
context ->
public_key_hash ->
Cycle.t ->
(context * frozen_balance) tzresult Lwt.t
val full_balance : context -> public_key_hash -> Tez.t tzresult Lwt.t
val has_frozen_balance :
context -> public_key_hash -> Cycle.t -> bool tzresult Lwt.t
val frozen_balance : context -> public_key_hash -> Tez.t tzresult Lwt.t
val frozen_balance_encoding : frozen_balance Data_encoding.t
val frozen_balance_by_cycle_encoding :
frozen_balance Cycle.Map.t Data_encoding.t
val frozen_balance_by_cycle :
context -> Signature.Public_key_hash.t -> frozen_balance Cycle.Map.t Lwt.t
val staking_balance :
context -> Signature.Public_key_hash.t -> Tez.t tzresult Lwt.t
val delegated_contracts :
context -> Signature.Public_key_hash.t -> Contract_repr.t list Lwt.t
val delegated_balance :
context -> Signature.Public_key_hash.t -> Tez.t tzresult Lwt.t
val deactivated :
context -> Signature.Public_key_hash.t -> bool tzresult Lwt.t
val grace_period :
context -> Signature.Public_key_hash.t -> Cycle.t tzresult Lwt.t
end
module Vote : sig
type proposal = Protocol_hash.t
val record_proposal :
context -> Protocol_hash.t -> public_key_hash -> context tzresult Lwt.t
val get_proposals : context -> int32 Protocol_hash.Map.t tzresult Lwt.t
val clear_proposals : context -> context Lwt.t
val recorded_proposal_count_for_delegate :
context -> public_key_hash -> int tzresult Lwt.t
val listings_encoding :
(Signature.Public_key_hash.t * int32) list Data_encoding.t
val freeze_listings : context -> context tzresult Lwt.t
val clear_listings : context -> context tzresult Lwt.t
val listing_size : context -> int32 tzresult Lwt.t
val in_listings : context -> public_key_hash -> bool Lwt.t
val get_listings : context -> (public_key_hash * int32) list Lwt.t
type ballot = Yay | Nay | Pass
val ballot_encoding : ballot Data_encoding.t
type ballots = {yay : int32; nay : int32; pass : int32}
val ballots_encoding : ballots Data_encoding.t
val has_recorded_ballot : context -> public_key_hash -> bool Lwt.t
val record_ballot :
context -> public_key_hash -> ballot -> context tzresult Lwt.t
val get_ballots : context -> ballots tzresult Lwt.t
val get_ballot_list :
context -> (Signature.Public_key_hash.t * ballot) list Lwt.t
val clear_ballots : context -> context Lwt.t
val get_current_period_kind : context -> Voting_period.kind tzresult Lwt.t
val set_current_period_kind :
context -> Voting_period.kind -> context tzresult Lwt.t
val get_current_quorum : context -> int32 tzresult Lwt.t
val get_participation_ema : context -> int32 tzresult Lwt.t
val set_participation_ema : context -> int32 -> context tzresult Lwt.t
val get_current_proposal : context -> proposal tzresult Lwt.t
val init_current_proposal : context -> proposal -> context tzresult Lwt.t
val clear_current_proposal : context -> context tzresult Lwt.t
end
module Block_header : sig
type t = {shell : Block_header.shell_header; protocol_data : protocol_data}
and protocol_data = {contents : contents; signature : Signature.t}
and contents = {
priority : int;
seed_nonce_hash : Nonce_hash.t option;
proof_of_work_nonce : MBytes.t;
}
type block_header = t
type raw = Block_header.t
type shell_header = Block_header.shell_header
val raw : block_header -> raw
val hash : block_header -> Block_hash.t
val hash_raw : raw -> Block_hash.t
val encoding : block_header Data_encoding.encoding
val raw_encoding : raw Data_encoding.t
val contents_encoding : contents Data_encoding.t
val unsigned_encoding : (shell_header * contents) Data_encoding.t
val protocol_data_encoding : protocol_data Data_encoding.encoding
val shell_header_encoding : shell_header Data_encoding.encoding
(** The maximum size of block headers in bytes *)
val max_header_length : int
end
module Kind : sig
type seed_nonce_revelation = Seed_nonce_revelation_kind
type double_endorsement_evidence = Double_endorsement_evidence_kind
type double_baking_evidence = Double_baking_evidence_kind
type activate_account = Activate_account_kind
type endorsement = Endorsement_kind
type proposals = Proposals_kind
type ballot = Ballot_kind
type reveal = Reveal_kind
type transaction = Transaction_kind
type origination = Origination_kind
type delegation = Delegation_kind
type 'a manager =
| Reveal_manager_kind : reveal manager
| Transaction_manager_kind : transaction manager
| Origination_manager_kind : origination manager
| Delegation_manager_kind : delegation manager
end
type 'kind operation = {
shell : Operation.shell_header;
protocol_data : 'kind protocol_data;
}
and 'kind protocol_data = {
contents : 'kind contents_list;
signature : Signature.t option;
}
and _ contents_list =
| Single : 'kind contents -> 'kind contents_list
| Cons :
'kind Kind.manager contents * 'rest Kind.manager contents_list
-> ('kind * 'rest) Kind.manager contents_list
and _ contents =
| Endorsement : {level : Raw_level.t} -> Kind.endorsement contents
| Seed_nonce_revelation : {
level : Raw_level.t;
nonce : Nonce.t;
}
-> Kind.seed_nonce_revelation contents
| Double_endorsement_evidence : {
op1 : Kind.endorsement operation;
op2 : Kind.endorsement operation;
}
-> Kind.double_endorsement_evidence contents
| Double_baking_evidence : {
bh1 : Block_header.t;
bh2 : Block_header.t;
}
-> Kind.double_baking_evidence contents
| Activate_account : {
id : Ed25519.Public_key_hash.t;
activation_code : Blinded_public_key_hash.activation_code;
}
-> Kind.activate_account contents
| Proposals : {
source : Signature.Public_key_hash.t;
period : Voting_period.t;
proposals : Protocol_hash.t list;
}
-> Kind.proposals contents
| Ballot : {
source : Signature.Public_key_hash.t;
period : Voting_period.t;
proposal : Protocol_hash.t;
ballot : Vote.ballot;
}
-> Kind.ballot contents
| Manager_operation : {
source : Signature.Public_key_hash.t;
fee : Tez.tez;
counter : counter;
operation : 'kind manager_operation;
gas_limit : Z.t;
storage_limit : Z.t;
}
-> 'kind Kind.manager contents
and _ manager_operation =
| Reveal : Signature.Public_key.t -> Kind.reveal manager_operation
| Transaction : {
amount : Tez.tez;
parameters : Script.lazy_expr;
entrypoint : string;
destination : Contract.contract;
}
-> Kind.transaction manager_operation
| Origination : {
delegate : Signature.Public_key_hash.t option;
script : Script.t;
credit : Tez.tez;
preorigination : Contract.t option;
}
-> Kind.origination manager_operation
| Delegation :
Signature.Public_key_hash.t option
-> Kind.delegation manager_operation
and counter = Z.t
type 'kind internal_operation = {
source : Contract.contract;
operation : 'kind manager_operation;
nonce : int;
}
type packed_manager_operation =
| Manager : 'kind manager_operation -> packed_manager_operation
type packed_contents = Contents : 'kind contents -> packed_contents
type packed_contents_list =
| Contents_list : 'kind contents_list -> packed_contents_list
type packed_protocol_data =
| Operation_data : 'kind protocol_data -> packed_protocol_data
type packed_operation = {
shell : Operation.shell_header;
protocol_data : packed_protocol_data;
}
type packed_internal_operation =
| Internal_operation : 'kind internal_operation -> packed_internal_operation
val manager_kind : 'kind manager_operation -> 'kind Kind.manager
module Fees : sig
val origination_burn : context -> (context * Tez.t) tzresult Lwt.t
val record_paid_storage_space :
context -> Contract.t -> (context * Z.t * Z.t * Tez.t) tzresult Lwt.t
val start_counting_storage_fees : context -> context
val burn_storage_fees :
context -> storage_limit:Z.t -> payer:Contract.t -> context tzresult Lwt.t
type error += Cannot_pay_storage_fee (* `Temporary *)
type error += Operation_quota_exceeded (* `Temporary *)
type error += Storage_limit_too_high (* `Permanent *)
val check_storage_limit : context -> storage_limit:Z.t -> unit tzresult
end
module Operation : sig
type nonrec 'kind contents = 'kind contents
type nonrec packed_contents = packed_contents
val contents_encoding : packed_contents Data_encoding.t
type nonrec 'kind protocol_data = 'kind protocol_data
type nonrec packed_protocol_data = packed_protocol_data
val protocol_data_encoding : packed_protocol_data Data_encoding.t
val unsigned_encoding :
(Operation.shell_header * packed_contents_list) Data_encoding.t
type raw = Operation.t = {shell : Operation.shell_header; proto : MBytes.t}
val raw_encoding : raw Data_encoding.t
val contents_list_encoding : packed_contents_list Data_encoding.t
type 'kind t = 'kind operation = {
shell : Operation.shell_header;
protocol_data : 'kind protocol_data;
}
type nonrec packed = packed_operation
val encoding : packed Data_encoding.t
val raw : _ operation -> raw
val hash : _ operation -> Operation_hash.t
val hash_raw : raw -> Operation_hash.t
val hash_packed : packed_operation -> Operation_hash.t
val acceptable_passes : packed_operation -> int list
type error += Missing_signature (* `Permanent *)
type error += Invalid_signature (* `Permanent *)
val check_signature :
public_key -> Chain_id.t -> _ operation -> unit tzresult Lwt.t
val check_signature_sync :
public_key -> Chain_id.t -> _ operation -> unit tzresult
val internal_operation_encoding : packed_internal_operation Data_encoding.t
val pack : 'kind operation -> packed_operation
type ('a, 'b) eq = Eq : ('a, 'a) eq
val equal : 'a operation -> 'b operation -> ('a, 'b) eq option
module Encoding : sig
type 'b case =
| Case : {
tag : int;
name : string;
encoding : 'a Data_encoding.t;
select : packed_contents -> 'b contents option;
proj : 'b contents -> 'a;
inj : 'a -> 'b contents;
}
-> 'b case
val endorsement_case : Kind.endorsement case
val seed_nonce_revelation_case : Kind.seed_nonce_revelation case
val double_endorsement_evidence_case :
Kind.double_endorsement_evidence case
val double_baking_evidence_case : Kind.double_baking_evidence case
val activate_account_case : Kind.activate_account case
val proposals_case : Kind.proposals case
val ballot_case : Kind.ballot case
val reveal_case : Kind.reveal Kind.manager case
val transaction_case : Kind.transaction Kind.manager case
val origination_case : Kind.origination Kind.manager case
val delegation_case : Kind.delegation Kind.manager case
module Manager_operations : sig
type 'b case =
| MCase : {
tag : int;
name : string;
encoding : 'a Data_encoding.t;
select :
packed_manager_operation -> 'kind manager_operation option;
proj : 'kind manager_operation -> 'a;
inj : 'a -> 'kind manager_operation;
}
-> 'kind case
val reveal_case : Kind.reveal case
val transaction_case : Kind.transaction case
val origination_case : Kind.origination case
val delegation_case : Kind.delegation case
end
end
val of_list : packed_contents list -> packed_contents_list
val to_list : packed_contents_list -> packed_contents list
end
module Roll : sig
type t = private int32
type roll = t
val encoding : roll Data_encoding.t
val snapshot_rolls : context -> context tzresult Lwt.t
val cycle_end : context -> Cycle.t -> context tzresult Lwt.t
val baking_rights_owner :
context -> Level.t -> priority:int -> public_key tzresult Lwt.t
val endorsement_rights_owner :
context -> Level.t -> slot:int -> public_key tzresult Lwt.t
val delegate_pubkey : context -> public_key_hash -> public_key tzresult Lwt.t
val get_rolls :
context -> Signature.Public_key_hash.t -> roll list tzresult Lwt.t
val get_change :
context -> Signature.Public_key_hash.t -> Tez.t tzresult Lwt.t
end
module Commitment : sig
type t = {
blinded_public_key_hash : Blinded_public_key_hash.t;
amount : Tez.tez;
}
val get_opt :
context -> Blinded_public_key_hash.t -> Tez.t option tzresult Lwt.t
val delete : context -> Blinded_public_key_hash.t -> context tzresult Lwt.t
end
module Bootstrap : sig
val cycle_end : context -> Cycle.t -> context tzresult Lwt.t
end
module Global : sig
val get_block_priority : context -> int tzresult Lwt.t
val set_block_priority : context -> int -> context tzresult Lwt.t
end
val prepare_first_block :
Context.t ->
typecheck:(context ->
Script.t ->
((Script.t * Contract.big_map_diff option) * context) tzresult
Lwt.t) ->
level:Int32.t ->
timestamp:Time.t ->
fitness:Fitness.t ->
context tzresult Lwt.t
val prepare :
Context.t ->
level:Int32.t ->
predecessor_timestamp:Time.t ->
timestamp:Time.t ->
fitness:Fitness.t ->
context tzresult Lwt.t
val finalize : ?commit_message:string -> context -> Updater.validation_result
val activate : context -> Protocol_hash.t -> context Lwt.t
val fork_test_chain : context -> Protocol_hash.t -> Time.t -> context Lwt.t
val record_endorsement : context -> Signature.Public_key_hash.t -> context
val allowed_endorsements :
context ->
(Signature.Public_key.t * int list * bool) Signature.Public_key_hash.Map.t
val init_endorsements :
context ->
(Signature.Public_key.t * int list * bool) Signature.Public_key_hash.Map.t ->
context
val included_endorsements : context -> int
val reset_internal_nonce : context -> context
val fresh_internal_nonce : context -> (context * int) tzresult
val record_internal_nonce : context -> int -> context
val internal_nonce_already_recorded : context -> int -> bool
val add_fees : context -> Tez.t -> context tzresult Lwt.t
val add_rewards : context -> Tez.t -> context tzresult Lwt.t
val add_deposit :
context -> Signature.Public_key_hash.t -> Tez.t -> context tzresult Lwt.t
val get_fees : context -> Tez.t
val get_rewards : context -> Tez.t
val get_deposits : context -> Tez.t Signature.Public_key_hash.Map.t
val description : context Storage_description.t
alpha_context_mli.v
Require Import OCaml.OCaml.
Local Open Scope Z_scope.
Local Open Scope type_scope.
Import ListNotations.
Module BASIC_DATA.
Record signature {t : Set} := {
t := t;
op_eq : t -> t -> bool;
op_ltgt : t -> t -> bool;
op_lt : t -> t -> bool;
op_lteq : t -> t -> bool;
op_gteq : t -> t -> bool;
op_gt : t -> t -> bool;
compare : t -> t -> Z;
equal : t -> t -> bool;
max : t -> t -> t;
min : t -> t -> t;
encoding : Tezos_protocol_environment_alpha__Environment.Data_encoding.t t;
pp :
Tezos_protocol_environment_alpha__Environment.Format.formatter -> t ->
unit;
}.
Arguments signature : clear implicits.
End BASIC_DATA.
Parameter t : Set.
Definition context := t.
Definition public_key :=
Tezos_protocol_environment_alpha__Environment.Signature.Public_key.t.
Definition public_key_hash :=
Tezos_protocol_environment_alpha__Environment.Signature.Public_key_hash.t.
Definition signature :=
Tezos_protocol_environment_alpha__Environment.Signature.t.
Module Tez.
Parameter t : Set.
Parameter op_eq : t -> t -> bool.
Parameter op_ltgt : t -> t -> bool.
Parameter op_lt : t -> t -> bool.
Parameter op_lteq : t -> t -> bool.
Parameter op_gteq : t -> t -> bool.
Parameter op_gt : t -> t -> bool.
Parameter compare : t -> t -> Z.
Parameter equal : t -> t -> bool.
Parameter max : t -> t -> t.
Parameter min : t -> t -> t.
Parameter encoding :
Tezos_protocol_environment_alpha__Environment.Data_encoding.t t.
Parameter pp :
Tezos_protocol_environment_alpha__Environment.Format.formatter -> t -> unit.
Definition tez := t.
Parameter zero : tez.
Parameter one_mutez : tez.
Parameter one_cent : tez.
Parameter fifty_cents : tez.
Parameter one : tez.
Parameter op_minusquestion :
tez -> tez ->
Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult tez.
Parameter op_plusquestion :
tez -> tez ->
Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult tez.
Parameter op_starquestion :
tez -> int64 ->
Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult tez.
Parameter op_divquestion :
tez -> int64 ->
Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult tez.
Parameter of_string : string -> option tez.
Parameter to_string : tez -> string.
Parameter of_mutez : int64 -> option tez.
Parameter to_mutez : tez -> int64.
End Tez.
Module Period.
Parameter t : Set.
Parameter op_eq : t -> t -> bool.
Parameter op_ltgt : t -> t -> bool.
Parameter op_lt : t -> t -> bool.
Parameter op_lteq : t -> t -> bool.
Parameter op_gteq : t -> t -> bool.
Parameter op_gt : t -> t -> bool.
Parameter compare : t -> t -> Z.
Parameter equal : t -> t -> bool.
Parameter max : t -> t -> t.
Parameter min : t -> t -> t.
Parameter encoding :
Tezos_protocol_environment_alpha__Environment.Data_encoding.t t.
Parameter pp :
Tezos_protocol_environment_alpha__Environment.Format.formatter -> t -> unit.
Definition period := t.
Parameter rpc_arg :
Tezos_protocol_environment_alpha__Environment.RPC_arg.arg period.
Parameter of_seconds :
int64 ->
Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult period.
Parameter to_seconds : period -> int64.
Parameter mult :
int32 -> period ->
Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult period.
Parameter zero : period.
Parameter one_second : period.
Parameter one_minute : period.
Parameter one_hour : period.
End Period.
Module Timestamp.
Definition t := Tezos_protocol_environment_alpha__Environment.Time.t.
Parameter op_eq : t -> t -> bool.
Parameter op_ltgt : t -> t -> bool.
Parameter op_lt : t -> t -> bool.
Parameter op_lteq : t -> t -> bool.
Parameter op_gteq : t -> t -> bool.
Parameter op_gt : t -> t -> bool.
Parameter compare : t -> t -> Z.
Parameter equal : t -> t -> bool.
Parameter max : t -> t -> t.
Parameter min : t -> t -> t.
Parameter encoding :
Tezos_protocol_environment_alpha__Environment.Data_encoding.t t.
Parameter pp :
Tezos_protocol_environment_alpha__Environment.Format.formatter -> t -> unit.
Definition time := t.
Parameter op_plusquestion :
time -> Period.t ->
Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult time.
Parameter op_minusquestion :
time -> time ->
Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult Period.t.
Parameter of_notation : string -> option time.
Parameter to_notation : time -> string.
Parameter of_seconds : string -> option time.
Parameter to_seconds_string : time -> string.
Parameter current : context -> time.
End Timestamp.
Module Raw_level.
Parameter t : Set.
Parameter op_eq : t -> t -> bool.
Parameter op_ltgt : t -> t -> bool.
Parameter op_lt : t -> t -> bool.
Parameter op_lteq : t -> t -> bool.
Parameter op_gteq : t -> t -> bool.
Parameter op_gt : t -> t -> bool.
Parameter compare : t -> t -> Z.
Parameter equal : t -> t -> bool.
Parameter max : t -> t -> t.
Parameter min : t -> t -> t.
Parameter encoding :
Tezos_protocol_environment_alpha__Environment.Data_encoding.t t.
Parameter pp :
Tezos_protocol_environment_alpha__Environment.Format.formatter -> t -> unit.
Definition raw_level := t.
Parameter rpc_arg :
Tezos_protocol_environment_alpha__Environment.RPC_arg.arg raw_level.
Parameter diff : raw_level -> raw_level -> int32.
Parameter root : raw_level.
Parameter succ : raw_level -> raw_level.
Parameter pred : raw_level -> option raw_level.
Parameter to_int32 : raw_level -> int32.
Parameter of_int32 :
int32 ->
Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult raw_level.
End Raw_level.
Module Cycle.
Parameter t : Set.
Parameter op_eq : t -> t -> bool.
Parameter op_ltgt : t -> t -> bool.
Parameter op_lt : t -> t -> bool.
Parameter op_lteq : t -> t -> bool.
Parameter op_gteq : t -> t -> bool.
Parameter op_gt : t -> t -> bool.
Parameter compare : t -> t -> Z.
Parameter equal : t -> t -> bool.
Parameter max : t -> t -> t.
Parameter min : t -> t -> t.
Parameter encoding :
Tezos_protocol_environment_alpha__Environment.Data_encoding.t t.
Parameter pp :
Tezos_protocol_environment_alpha__Environment.Format.formatter -> t -> unit.
Definition cycle := t.
Parameter rpc_arg :
Tezos_protocol_environment_alpha__Environment.RPC_arg.arg cycle.
Parameter root : cycle.
Parameter succ : cycle -> cycle.
Parameter pred : cycle -> option cycle.
Parameter add : cycle -> Z -> cycle.
Parameter sub : cycle -> Z -> option cycle.
Parameter to_int32 : cycle -> int32.
Module Map.
Definition key := cycle.
Parameter t : forall (a : Set), Set.
Parameter empty : forall {a : Set}, t a.
Parameter is_empty : forall {a : Set}, t a -> bool.
Parameter mem : forall {a : Set}, key -> t a -> bool.
Parameter add : forall {a : Set}, key -> a -> t a -> t a.
Parameter update : forall {a : Set},
key -> (option a -> option a) -> t a -> t a.
Parameter singleton : forall {a : Set}, key -> a -> t a.
Parameter remove : forall {a : Set}, key -> t a -> t a.
Parameter merge : forall {a b c : Set},
(key -> option a -> option b -> option c) -> t a -> t b -> t c.
Parameter union : forall {a : Set},
(key -> a -> a -> option a) -> t a -> t a -> t a.
Parameter compare : forall {a : Set}, (a -> a -> Z) -> t a -> t a -> Z.
Parameter equal : forall {a : Set}, (a -> a -> bool) -> t a -> t a -> bool.
Parameter iter : forall {a : Set}, (key -> a -> unit) -> t a -> unit.
Parameter fold : forall {a b : Set}, (key -> a -> b -> b) -> t a -> b -> b.
Parameter for_all : forall {a : Set}, (key -> a -> bool) -> t a -> bool.
Parameter __exists : forall {a : Set}, (key -> a -> bool) -> t a -> bool.
Parameter filter : forall {a : Set}, (key -> a -> bool) -> t a -> t a.
Parameter partition : forall {a : Set},
(key -> a -> bool) -> t a -> t a * t a.
Parameter cardinal : forall {a : Set}, t a -> Z.
Parameter bindings : forall {a : Set}, t a -> list (key * a).
Parameter min_binding_opt : forall {a : Set}, t a -> option (key * a).
Parameter max_binding_opt : forall {a : Set}, t a -> option (key * a).
Parameter choose_opt : forall {a : Set}, t a -> option (key * a).
Parameter split : forall {a : Set}, key -> t a -> t a * option a * t a.
Parameter find_opt : forall {a : Set}, key -> t a -> option a.
Parameter find_first_opt : forall {a : Set},
(key -> bool) -> t a -> option (key * a).
Parameter find_last_opt : forall {a : Set},
(key -> bool) -> t a -> option (key * a).
Parameter map : forall {a b : Set}, (a -> b) -> t a -> t b.
Parameter mapi : forall {a b : Set}, (key -> a -> b) -> t a -> t b.
End Map.
End Cycle.
Module Gas.
Inductive t : Set :=
| Unaccounted : t
| Limited : Tezos_protocol_environment_alpha__Environment.Z.t -> t.
Parameter encoding :
Tezos_protocol_environment_alpha__Environment.Data_encoding.encoding t.
Parameter pp :
Tezos_protocol_environment_alpha__Environment.Format.formatter -> t -> unit.
Parameter cost : Set.
Parameter cost_encoding :
Tezos_protocol_environment_alpha__Environment.Data_encoding.encoding cost.
Parameter pp_cost :
Tezos_protocol_environment_alpha__Environment.Format.formatter -> cost ->
unit.
(* extensible_type Tezos_protocol_environment_alpha__Environment.Error_monad.error *)
(* extensible_type Tezos_protocol_environment_alpha__Environment.Error_monad.error *)
(* extensible_type Tezos_protocol_environment_alpha__Environment.Error_monad.error *)
Parameter free : cost.
Parameter atomic_step_cost : Z -> cost.
Parameter step_cost : Z -> cost.
Parameter alloc_cost : Z -> cost.
Parameter alloc_bytes_cost : Z -> cost.
Parameter alloc_mbytes_cost : Z -> cost.
Parameter alloc_bits_cost : Z -> cost.
Parameter read_bytes_cost :
Tezos_protocol_environment_alpha__Environment.Z.t -> cost.
Parameter write_bytes_cost :
Tezos_protocol_environment_alpha__Environment.Z.t -> cost.
Parameter op_starat : Z -> cost -> cost.
Parameter op_plusat : cost -> cost -> cost.
Parameter check_limit :
context -> Tezos_protocol_environment_alpha__Environment.Z.t ->
Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult unit.
Parameter set_limit :
context -> Tezos_protocol_environment_alpha__Environment.Z.t -> context.
Parameter set_unlimited : context -> context.
Parameter consume :
context -> cost ->
Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult context.
Parameter check_enough :
context -> cost ->
Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult unit.
Parameter level : context -> t.
Parameter consumed :
context -> context -> Tezos_protocol_environment_alpha__Environment.Z.t.
Parameter block_level :
context -> Tezos_protocol_environment_alpha__Environment.Z.t.
End Gas.
Module Script_int.
Definition num (t : Set) := Tezos_raw_protocol_alpha__Script_int_repr.num t.
Definition n := Tezos_raw_protocol_alpha__Script_int_repr.n.
Definition z := Tezos_raw_protocol_alpha__Script_int_repr.z.
Parameter zero_n : num n.
Parameter zero : num z.
Parameter compare : forall {a : Set}, num a -> num a -> Z.
Parameter to_string : forall {A : Set}, num A -> string.
Parameter of_string : string -> option (num z).
Parameter to_int64 : forall {A : Set}, num A -> option int64.
Parameter of_int64 : int64 -> num z.
Parameter to_int : forall {A : Set}, num A -> option Z.
Parameter of_int : Z -> num z.
Parameter of_zint :
Tezos_protocol_environment_alpha__Environment.Z.t -> num z.
Parameter to_zint : forall {a : Set},
num a -> Tezos_protocol_environment_alpha__Environment.Z.t.
Parameter add_n : num n -> num n -> num n.
Parameter mul_n : num n -> num n -> num n.
Parameter ediv_n : num n -> num n -> option (num n * num n).
Parameter add : forall {A B : Set}, num A -> num B -> num z.
Parameter sub : forall {A B : Set}, num A -> num B -> num z.
Parameter mul : forall {A B : Set}, num A -> num B -> num z.
Parameter ediv : forall {A B : Set}, num A -> num B -> option (num z * num n).
Parameter abs : num z -> num n.
Parameter is_nat : num z -> option (num n).
Parameter neg : forall {A : Set}, num A -> num z.
Parameter int : num n -> num z.
Parameter lognot : forall {A : Set}, num A -> num z.
Parameter shift_left_n : num n -> num n -> option (num n).
Parameter shift_right_n : num n -> num n -> option (num n).
Parameter shift_left : forall {a : Set}, num a -> num n -> option (num a).
Parameter shift_right : forall {a : Set}, num a -> num n -> option (num a).
Parameter logor : forall {a : Set}, num a -> num a -> num a.
Parameter logand : forall {A : Set}, num A -> num n -> num n.
Parameter logxor : num n -> num n -> num n.
End Script_int.
Module Script_timestamp.
Parameter t : Set.
Parameter compare : t -> t -> Z.
Parameter to_string : t -> string.
Parameter to_notation : t -> option string.
Parameter to_num_str : t -> string.
Parameter of_string : string -> option t.
Parameter diff : t -> t -> Script_int.num Script_int.z.
Parameter add_delta : t -> Script_int.num Script_int.z -> t.
Parameter sub_delta : t -> Script_int.num Script_int.z -> t.
Parameter now : context -> t.
Parameter to_zint : t -> Tezos_protocol_environment_alpha__Environment.Z.t.
Parameter of_zint : Tezos_protocol_environment_alpha__Environment.Z.t -> t.
End Script_timestamp.
Module Script.
Inductive prim : Set :=
| K_parameter : prim
| K_storage : prim
| K_code : prim
| D_False : prim
| D_Elt : prim
| D_Left : prim
| D_None : prim
| D_Pair : prim
| D_Right : prim
| D_Some : prim
| D_True : prim
| D_Unit : prim
| I_PACK : prim
| I_UNPACK : prim
| I_BLAKE2B : prim
| I_SHA256 : prim
| I_SHA512 : prim
| I_ABS : prim
| I_ADD : prim
| I_AMOUNT : prim
| I_AND : prim
| I_BALANCE : prim
| I_CAR : prim
| I_CDR : prim
| I_CHAIN_ID : prim
| I_CHECK_SIGNATURE : prim
| I_COMPARE : prim
| I_CONCAT : prim
| I_CONS : prim
| I_CREATE_ACCOUNT : prim
| I_CREATE_CONTRACT : prim
| I_IMPLICIT_ACCOUNT : prim
| I_DIP : prim
| I_DROP : prim
| I_DUP : prim
| I_EDIV : prim
| I_EMPTY_BIG_MAP : prim
| I_EMPTY_MAP : prim
| I_EMPTY_SET : prim
| I_EQ : prim
| I_EXEC : prim
| I_APPLY : prim
| I_FAILWITH : prim
| I_GE : prim
| I_GET : prim
| I_GT : prim
| I_HASH_KEY : prim
| I_IF : prim
| I_IF_CONS : prim
| I_IF_LEFT : prim
| I_IF_NONE : prim
| I_INT : prim
| I_LAMBDA : prim
| I_LE : prim
| I_LEFT : prim
| I_LOOP : prim
| I_LSL : prim
| I_LSR : prim
| I_LT : prim
| I_MAP : prim
| I_MEM : prim
| I_MUL : prim
| I_NEG : prim
| I_NEQ : prim
| I_NIL : prim
| I_NONE : prim
| I_NOT : prim
| I_NOW : prim
| I_OR : prim
| I_PAIR : prim
| I_PUSH : prim
| I_RIGHT : prim
| I_SIZE : prim
| I_SOME : prim
| I_SOURCE : prim
| I_SENDER : prim
| I_SELF : prim
| I_SLICE : prim
| I_STEPS_TO_QUOTA : prim
| I_SUB : prim
| I_SWAP : prim
| I_TRANSFER_TOKENS : prim
| I_SET_DELEGATE : prim
| I_UNIT : prim
| I_UPDATE : prim
| I_XOR : prim
| I_ITER : prim
| I_LOOP_LEFT : prim
| I_ADDRESS : prim
| I_CONTRACT : prim
| I_ISNAT : prim
| I_CAST : prim
| I_RENAME : prim
| I_DIG : prim
| I_DUG : prim
| T_bool : prim
| T_contract : prim
| T_int : prim
| T_key : prim
| T_key_hash : prim
| T_lambda : prim
| T_list : prim
| T_map : prim
| T_big_map : prim
| T_nat : prim
| T_option : prim
| T_or : prim
| T_pair : prim
| T_set : prim
| T_signature : prim
| T_string : prim
| T_bytes : prim
| T_mutez : prim
| T_timestamp : prim
| T_unit : prim
| T_operation : prim
| T_address : prim
| T_chain_id : prim.
Definition location :=
Tezos_protocol_environment_alpha__Environment.Micheline.canonical_location.
Definition annot :=
Tezos_protocol_environment_alpha__Environment.Micheline.annot.
Definition expr :=
Tezos_protocol_environment_alpha__Environment.Micheline.canonical prim.
Definition lazy_expr :=
Tezos_protocol_environment_alpha__Environment.Data_encoding.lazy_t expr.
Parameter lazy_expr : expr -> lazy_expr.
Definition node :=
Tezos_protocol_environment_alpha__Environment.Micheline.node location prim.
Module t.
Record record := {
code : lazy_expr;
storage : lazy_expr }.
End t.
Definition t := t.record.
Parameter location_encoding :
Tezos_protocol_environment_alpha__Environment.Data_encoding.t location.
Parameter expr_encoding :
Tezos_protocol_environment_alpha__Environment.Data_encoding.t expr.
Parameter prim_encoding :
Tezos_protocol_environment_alpha__Environment.Data_encoding.t prim.
Parameter encoding :
Tezos_protocol_environment_alpha__Environment.Data_encoding.t t.
Parameter lazy_expr_encoding :
Tezos_protocol_environment_alpha__Environment.Data_encoding.t lazy_expr.
Parameter deserialized_cost : expr -> Gas.cost.
Parameter serialized_cost :
Tezos_protocol_environment_alpha__Environment.MBytes.t -> Gas.cost.
Parameter traversal_cost : node -> Gas.cost.
Parameter node_cost : node -> Gas.cost.
Parameter int_node_cost :
Tezos_protocol_environment_alpha__Environment.Z.t -> Gas.cost.
Parameter int_node_cost_of_numbits : Z -> Gas.cost.
Parameter string_node_cost : string -> Gas.cost.
Parameter string_node_cost_of_length : Z -> Gas.cost.
Parameter bytes_node_cost :
Tezos_protocol_environment_alpha__Environment.MBytes.t -> Gas.cost.
Parameter bytes_node_cost_of_length : Z -> Gas.cost.
Parameter prim_node_cost_nonrec : list expr -> annot -> Gas.cost.
Parameter prim_node_cost_nonrec_of_length : Z -> annot -> Gas.cost.
Parameter seq_node_cost_nonrec : list expr -> Gas.cost.
Parameter seq_node_cost_nonrec_of_length : Z -> Gas.cost.
Parameter minimal_deserialize_cost : lazy_expr -> Gas.cost.
Parameter force_decode :
context -> lazy_expr ->
Tezos_protocol_environment_alpha__Environment.Lwt.t
(Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
(expr * context)).
Parameter force_bytes :
context -> lazy_expr ->
Tezos_protocol_environment_alpha__Environment.Lwt.t
(Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
(Tezos_protocol_environment_alpha__Environment.MBytes.t * context)).
Parameter unit_parameter : lazy_expr.
Module Legacy_support.
Parameter manager_script_code : lazy_expr.
Parameter add_do :
Tezos_protocol_environment_alpha__Environment.Signature.Public_key_hash.t
-> lazy_expr -> lazy_expr ->
Tezos_protocol_environment_alpha__Environment.Lwt.t
(Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
(lazy_expr * lazy_expr)).
Parameter add_set_delegate :
Tezos_protocol_environment_alpha__Environment.Signature.Public_key_hash.t
-> lazy_expr -> lazy_expr ->
Tezos_protocol_environment_alpha__Environment.Lwt.t
(Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
(lazy_expr * lazy_expr)).
Parameter has_default_entrypoint : lazy_expr -> bool.
Parameter add_root_entrypoint :
lazy_expr ->
Tezos_protocol_environment_alpha__Environment.Lwt.t
(Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
lazy_expr).
End Legacy_support.
End Script.
Module Constants.
Module fixed.
Record record := {
proof_of_work_nonce_size : Z;
nonce_length : Z;
max_revelations_per_block : Z;
max_operation_data_length : Z;
max_proposals_per_delegate : Z }.
End fixed.
Definition fixed := fixed.record.
Parameter fixed_encoding :
Tezos_protocol_environment_alpha__Environment.Data_encoding.t fixed.
Parameter fixed : fixed.
Parameter proof_of_work_nonce_size : Z.
Parameter nonce_length : Z.
Parameter max_revelations_per_block : Z.
Parameter max_operation_data_length : Z.
Parameter max_proposals_per_delegate : Z.
Module parametric.
Record record := {
preserved_cycles : Z;
blocks_per_cycle : int32;
blocks_per_commitment : int32;
blocks_per_roll_snapshot : int32;
blocks_per_voting_period : int32;
time_between_blocks : list Period.t;
endorsers_per_block : Z;
hard_gas_limit_per_operation :
Tezos_protocol_environment_alpha__Environment.Z.t;
hard_gas_limit_per_block :
Tezos_protocol_environment_alpha__Environment.Z.t;
proof_of_work_threshold : int64;
tokens_per_roll : Tez.t;
michelson_maximum_type_size : Z;
seed_nonce_revelation_tip : Tez.t;
origination_size : Z;
block_security_deposit : Tez.t;
endorsement_security_deposit : Tez.t;
block_reward : Tez.t;
endorsement_reward : Tez.t;
cost_per_byte : Tez.t;
hard_storage_limit_per_operation :
Tezos_protocol_environment_alpha__Environment.Z.t;
test_chain_duration : int64;
quorum_min : int32;
quorum_max : int32;
min_proposal_quorum : int32;
initial_endorsers : Z;
delay_per_missing_endorsement : Period.t }.
End parametric.
Definition parametric := parametric.record.
Parameter parametric_encoding :
Tezos_protocol_environment_alpha__Environment.Data_encoding.t parametric.
Parameter parametric : context -> parametric.
Parameter preserved_cycles : context -> Z.
Parameter blocks_per_cycle : context -> int32.
Parameter blocks_per_commitment : context -> int32.
Parameter blocks_per_roll_snapshot : context -> int32.
Parameter blocks_per_voting_period : context -> int32.
Parameter time_between_blocks : context -> list Period.t.
Parameter endorsers_per_block : context -> Z.
Parameter initial_endorsers : context -> Z.
Parameter delay_per_missing_endorsement : context -> Period.t.
Parameter hard_gas_limit_per_operation :
context -> Tezos_protocol_environment_alpha__Environment.Z.t.
Parameter hard_gas_limit_per_block :
context -> Tezos_protocol_environment_alpha__Environment.Z.t.
Parameter cost_per_byte : context -> Tez.t.
Parameter hard_storage_limit_per_operation :
context -> Tezos_protocol_environment_alpha__Environment.Z.t.
Parameter proof_of_work_threshold : context -> int64.
Parameter tokens_per_roll : context -> Tez.t.
Parameter michelson_maximum_type_size : context -> Z.
Parameter block_reward : context -> Tez.t.
Parameter endorsement_reward : context -> Tez.t.
Parameter seed_nonce_revelation_tip : context -> Tez.t.
Parameter origination_size : context -> Z.
Parameter block_security_deposit : context -> Tez.t.
Parameter endorsement_security_deposit : context -> Tez.t.
Parameter test_chain_duration : context -> int64.
Parameter quorum_min : context -> int32.
Parameter quorum_max : context -> int32.
Parameter min_proposal_quorum : context -> int32.
Module t.
Record record := {
fixed : fixed;
parametric : parametric }.
End t.
Definition t := t.record.
Parameter encoding :
Tezos_protocol_environment_alpha__Environment.Data_encoding.t t.
End Constants.
Module Voting_period.
Parameter t : Set.
Parameter op_eq : t -> t -> bool.
Parameter op_ltgt : t -> t -> bool.
Parameter op_lt : t -> t -> bool.
Parameter op_lteq : t -> t -> bool.
Parameter op_gteq : t -> t -> bool.
Parameter op_gt : t -> t -> bool.
Parameter compare : t -> t -> Z.
Parameter equal : t -> t -> bool.
Parameter max : t -> t -> t.
Parameter min : t -> t -> t.
Parameter encoding :
Tezos_protocol_environment_alpha__Environment.Data_encoding.t t.
Parameter pp :
Tezos_protocol_environment_alpha__Environment.Format.formatter -> t -> unit.
Definition voting_period := t.
Parameter rpc_arg :
Tezos_protocol_environment_alpha__Environment.RPC_arg.arg voting_period.
Parameter root : voting_period.
Parameter succ : voting_period -> voting_period.
Inductive kind : Set :=
| Proposal : kind
| Testing_vote : kind
| Testing : kind
| Promotion_vote : kind.
Parameter kind_encoding :
Tezos_protocol_environment_alpha__Environment.Data_encoding.encoding kind.
Parameter to_int32 : voting_period -> int32.
End Voting_period.
Module Level.
Module t.
Record record := {
level : Raw_level.t;
level_position : int32;
cycle : Cycle.t;
cycle_position : int32;
voting_period : Voting_period.t;
voting_period_position : int32;
expected_commitment : bool }.
End t.
Definition t := t.record.
Parameter op_eq : t -> t -> bool.
Parameter op_ltgt : t -> t -> bool.
Parameter op_lt : t -> t -> bool.
Parameter op_lteq : t -> t -> bool.
Parameter op_gteq : t -> t -> bool.
Parameter op_gt : t -> t -> bool.
Parameter compare : t -> t -> Z.
Parameter equal : t -> t -> bool.
Parameter max : t -> t -> t.
Parameter min : t -> t -> t.
Parameter encoding :
Tezos_protocol_environment_alpha__Environment.Data_encoding.t t.
Parameter pp :
Tezos_protocol_environment_alpha__Environment.Format.formatter -> t -> unit.
Parameter pp_full :
Tezos_protocol_environment_alpha__Environment.Format.formatter -> t -> unit.
Definition level := t.
Parameter root : context -> level.
Parameter succ : context -> level -> level.
Parameter pred : context -> level -> option level.
Parameter from_raw : context -> option int32 -> Raw_level.t -> level.
Parameter diff : level -> level -> int32.
Parameter current : context -> level.
Parameter last_level_in_cycle : context -> Cycle.t -> level.
Parameter levels_in_cycle : context -> Cycle.t -> list level.
Parameter levels_in_current_cycle :
context -> option int32 -> unit -> list level.
Parameter last_allowed_fork_level : context -> Raw_level.t.
End Level.
Module Fitness.
Definition t := list Tezos_protocol_environment_alpha__Environment.MBytes.t.
Parameter op_eq : t -> t -> bool.
Parameter op_ltgt : t -> t -> bool.
Parameter op_lt : t -> t -> bool.
Parameter op_lteq : t -> t -> bool.
Parameter op_gteq : t -> t -> bool.
Parameter op_gt : t -> t -> bool.
Parameter compare : t -> t -> Z.
Parameter equal : t -> t -> bool.
Parameter max : t -> t -> t.
Parameter min : t -> t -> t.
Parameter pp :
Tezos_protocol_environment_alpha__Environment.Format.formatter -> t -> unit.
Parameter encoding :
Tezos_protocol_environment_alpha__Environment.Data_encoding.t t.
Parameter to_bytes :
t -> Tezos_protocol_environment_alpha__Environment.MBytes.t.
Parameter of_bytes :
Tezos_protocol_environment_alpha__Environment.MBytes.t -> option t.
Definition fitness := t.
Parameter increase : option Z -> context -> context.
Parameter current : context -> int64.
Parameter to_int64 :
fitness ->
Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult int64.
End Fitness.
Module Nonce.
Parameter t : Set.
Definition nonce := t.
Parameter encoding :
Tezos_protocol_environment_alpha__Environment.Data_encoding.t nonce.
Module unrevealed.
Record record := {
nonce_hash : Tezos_raw_protocol_alpha.Nonce_hash.t;
delegate : public_key_hash;
rewards : Tez.t;
fees : Tez.t }.
End unrevealed.
Definition unrevealed := unrevealed.record.
Parameter record_hash :
context -> unrevealed ->
Tezos_protocol_environment_alpha__Environment.Lwt.t
(Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
context).
Parameter reveal :
context -> Level.t -> nonce ->
Tezos_protocol_environment_alpha__Environment.Lwt.t
(Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
context).
Inductive status : Set :=
| Unrevealed : unrevealed -> status
| Revealed : nonce -> status.
Parameter get :
context -> Level.t ->
Tezos_protocol_environment_alpha__Environment.Lwt.t
(Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult status).
Parameter of_bytes :
Tezos_protocol_environment_alpha__Environment.MBytes.t ->
Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult nonce.
Parameter __hash_value : nonce -> Tezos_raw_protocol_alpha.Nonce_hash.t.
Parameter check_hash : nonce -> Tezos_raw_protocol_alpha.Nonce_hash.t -> bool.
End Nonce.
Module Seed.
Parameter seed : Set.
(* extensible_type Tezos_protocol_environment_alpha__Environment.Error_monad.error *)
Parameter for_cycle :
context -> Cycle.t ->
Tezos_protocol_environment_alpha__Environment.Lwt.t
(Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult seed).
Parameter cycle_end :
context -> Cycle.t ->
Tezos_protocol_environment_alpha__Environment.Lwt.t
(Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
(context * list Nonce.unrevealed)).
Parameter seed_encoding :
Tezos_protocol_environment_alpha__Environment.Data_encoding.t seed.
End Seed.
Module Big_map.
Definition id := Tezos_protocol_environment_alpha__Environment.Z.t.
Parameter fresh :
context ->
Tezos_protocol_environment_alpha__Environment.Lwt.t
(Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
(context * id)).
Parameter fresh_temporary : context -> context * id.
Parameter mem :
context -> id -> Tezos_raw_protocol_alpha.Script_expr_hash.t ->
Tezos_protocol_environment_alpha__Environment.Lwt.t
(Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
(context * bool)).
Parameter get_opt :
context -> id -> Tezos_raw_protocol_alpha.Script_expr_hash.t ->
Tezos_protocol_environment_alpha__Environment.Lwt.t
(Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
(context * option Script.expr)).
Parameter rpc_arg :
Tezos_protocol_environment_alpha__Environment.RPC_arg.t id.
Parameter cleanup_temporary :
context -> Tezos_protocol_environment_alpha__Environment.Lwt.t context.
Parameter __exists :
context -> id ->
Tezos_protocol_environment_alpha__Environment.Lwt.t
(Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
(context * option (Script.expr * Script.expr))).
End Big_map.
Module Contract.
Parameter t : Set.
Parameter op_eq : t -> t -> bool.
Parameter op_ltgt : t -> t -> bool.
Parameter op_lt : t -> t -> bool.
Parameter op_lteq : t -> t -> bool.
Parameter op_gteq : t -> t -> bool.
Parameter op_gt : t -> t -> bool.
Parameter compare : t -> t -> Z.
Parameter equal : t -> t -> bool.
Parameter max : t -> t -> t.
Parameter min : t -> t -> t.
Parameter encoding :
Tezos_protocol_environment_alpha__Environment.Data_encoding.t t.
Parameter pp :
Tezos_protocol_environment_alpha__Environment.Format.formatter -> t -> unit.
Definition contract := t.
Parameter rpc_arg :
Tezos_protocol_environment_alpha__Environment.RPC_arg.arg contract.
Parameter to_b58check : contract -> string.
Parameter of_b58check :
string ->
Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult contract.
Parameter implicit_contract : public_key_hash -> contract.
Parameter is_implicit : contract -> option public_key_hash.
Parameter __exists :
context -> contract ->
Tezos_protocol_environment_alpha__Environment.Lwt.t
(Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult bool).
Parameter must_exist :
context -> contract ->
Tezos_protocol_environment_alpha__Environment.Lwt.t
(Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult unit).
Parameter allocated :
context -> contract ->
Tezos_protocol_environment_alpha__Environment.Lwt.t
(Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult bool).
Parameter must_be_allocated :
context -> contract ->
Tezos_protocol_environment_alpha__Environment.Lwt.t
(Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult unit).
Parameter __list_value :
context ->
Tezos_protocol_environment_alpha__Environment.Lwt.t (list contract).
Parameter get_manager_key :
context -> public_key_hash ->
Tezos_protocol_environment_alpha__Environment.Lwt.t
(Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
public_key).
Parameter is_manager_key_revealed :
context -> public_key_hash ->
Tezos_protocol_environment_alpha__Environment.Lwt.t
(Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult bool).
Parameter reveal_manager_key :
context -> public_key_hash -> public_key ->
Tezos_protocol_environment_alpha__Environment.Lwt.t
(Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
context).
Parameter get_script_code :
context -> contract ->
Tezos_protocol_environment_alpha__Environment.Lwt.t
(Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
(context * option Script.lazy_expr)).
Parameter get_script :
context -> contract ->
Tezos_protocol_environment_alpha__Environment.Lwt.t
(Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
(context * option Script.t)).
Parameter get_storage :
context -> contract ->
Tezos_protocol_environment_alpha__Environment.Lwt.t
(Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
(context * option Script.expr)).
Parameter get_counter :
context -> public_key_hash ->
Tezos_protocol_environment_alpha__Environment.Lwt.t
(Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
Tezos_protocol_environment_alpha__Environment.Z.t).
Parameter get_balance :
context -> contract ->
Tezos_protocol_environment_alpha__Environment.Lwt.t
(Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult Tez.t).
Parameter init_origination_nonce :
context -> Tezos_protocol_environment_alpha__Environment.Operation_hash.t ->
context.
Parameter unset_origination_nonce : context -> context.
Parameter fresh_contract_from_current_nonce :
context ->
Tezos_protocol_environment_alpha__Environment.Lwt.t
(Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
(context * t)).
Parameter originated_from_current_nonce :
context -> context ->
Tezos_protocol_environment_alpha__Environment.Lwt.t
(Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
(list contract)).
Inductive big_map_diff_item : Set :=
| Update :
Big_map.id -> Script.expr -> Tezos_raw_protocol_alpha.Script_expr_hash.t ->
option Script.expr -> big_map_diff_item
| Clear : Big_map.id -> big_map_diff_item
| Copy : Big_map.id -> Big_map.id -> big_map_diff_item
| Alloc : Big_map.id -> Script.expr -> Script.expr -> big_map_diff_item.
Definition big_map_diff := list big_map_diff_item.
Parameter big_map_diff_encoding :
Tezos_protocol_environment_alpha__Environment.Data_encoding.t big_map_diff.
Parameter originate :
context -> contract -> Tez.t -> Script.t * option big_map_diff ->
option public_key_hash ->
Tezos_protocol_environment_alpha__Environment.Lwt.t
(Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
context).
(* extensible_type Tezos_protocol_environment_alpha__Environment.Error_monad.error *)
Parameter spend :
context -> contract -> Tez.t ->
Tezos_protocol_environment_alpha__Environment.Lwt.t
(Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
context).
Parameter credit :
context -> contract -> Tez.t ->
Tezos_protocol_environment_alpha__Environment.Lwt.t
(Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
context).
Parameter update_script_storage :
context -> contract -> Script.expr -> option big_map_diff ->
Tezos_protocol_environment_alpha__Environment.Lwt.t
(Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
context).
Parameter used_storage_space :
context -> t ->
Tezos_protocol_environment_alpha__Environment.Lwt.t
(Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
Tezos_protocol_environment_alpha__Environment.Z.t).
Parameter increment_counter :
context -> public_key_hash ->
Tezos_protocol_environment_alpha__Environment.Lwt.t
(Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
context).
Parameter check_counter_increment :
context -> public_key_hash ->
Tezos_protocol_environment_alpha__Environment.Z.t ->
Tezos_protocol_environment_alpha__Environment.Lwt.t
(Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult unit).
Parameter origination_nonce : Set.
Parameter initial_origination_nonce :
Tezos_protocol_environment_alpha__Environment.Operation_hash.t ->
origination_nonce.
Parameter originated_contract : origination_nonce -> contract.
End Contract.
Module Delegate.
Inductive balance : Set :=
| Contract : Contract.t -> balance
| Rewards :
Tezos_protocol_environment_alpha__Environment.Signature.Public_key_hash.t ->
Cycle.t -> balance
| Fees :
Tezos_protocol_environment_alpha__Environment.Signature.Public_key_hash.t ->
Cycle.t -> balance
| Deposits :
Tezos_protocol_environment_alpha__Environment.Signature.Public_key_hash.t ->
Cycle.t -> balance.
Inductive balance_update : Set :=
| Debited : Tez.t -> balance_update
| Credited : Tez.t -> balance_update.
Definition balance_updates := list (balance * balance_update).
Parameter balance_updates_encoding :
Tezos_protocol_environment_alpha__Environment.Data_encoding.t
balance_updates.
Parameter cleanup_balance_updates : balance_updates -> balance_updates.
Parameter get :
context -> Contract.t ->
Tezos_protocol_environment_alpha__Environment.Lwt.t
(Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
(option public_key_hash)).
Parameter set :
context -> Contract.t -> option public_key_hash ->
Tezos_protocol_environment_alpha__Environment.Lwt.t
(Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
context).
Parameter fold : forall {a : Set},
context -> a ->
(public_key_hash -> a ->
Tezos_protocol_environment_alpha__Environment.Lwt.t a) ->
Tezos_protocol_environment_alpha__Environment.Lwt.t a.
Parameter __list_value :
context ->
Tezos_protocol_environment_alpha__Environment.Lwt.t (list public_key_hash).
Parameter freeze_deposit :
context -> public_key_hash -> Tez.t ->
Tezos_protocol_environment_alpha__Environment.Lwt.t
(Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
context).
Parameter freeze_rewards :
context -> public_key_hash -> Tez.t ->
Tezos_protocol_environment_alpha__Environment.Lwt.t
(Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
context).
Parameter freeze_fees :
context -> public_key_hash -> Tez.t ->
Tezos_protocol_environment_alpha__Environment.Lwt.t
(Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
context).
Parameter cycle_end :
context -> Cycle.t -> list Nonce.unrevealed ->
Tezos_protocol_environment_alpha__Environment.Lwt.t
(Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
(context * balance_updates *
list
Tezos_protocol_environment_alpha__Environment.Signature.Public_key_hash.t)).
Module frozen_balance.
Record record := {
deposit : Tez.t;
fees : Tez.t;
rewards : Tez.t }.
End frozen_balance.
Definition frozen_balance := frozen_balance.record.
Parameter punish :
context -> public_key_hash -> Cycle.t ->
Tezos_protocol_environment_alpha__Environment.Lwt.t
(Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
(context * frozen_balance)).
Parameter full_balance :
context -> public_key_hash ->
Tezos_protocol_environment_alpha__Environment.Lwt.t
(Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult Tez.t).
Parameter has_frozen_balance :
context -> public_key_hash -> Cycle.t ->
Tezos_protocol_environment_alpha__Environment.Lwt.t
(Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult bool).
Parameter frozen_balance :
context -> public_key_hash ->
Tezos_protocol_environment_alpha__Environment.Lwt.t
(Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult Tez.t).
Parameter frozen_balance_encoding :
Tezos_protocol_environment_alpha__Environment.Data_encoding.t frozen_balance.
Parameter frozen_balance_by_cycle_encoding :
Tezos_protocol_environment_alpha__Environment.Data_encoding.t
(Cycle.Map.t frozen_balance).
Parameter frozen_balance_by_cycle :
context ->
Tezos_protocol_environment_alpha__Environment.Signature.Public_key_hash.t ->
Tezos_protocol_environment_alpha__Environment.Lwt.t
(Cycle.Map.t frozen_balance).
Parameter staking_balance :
context ->
Tezos_protocol_environment_alpha__Environment.Signature.Public_key_hash.t ->
Tezos_protocol_environment_alpha__Environment.Lwt.t
(Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult Tez.t).
Parameter delegated_contracts :
context ->
Tezos_protocol_environment_alpha__Environment.Signature.Public_key_hash.t ->
Tezos_protocol_environment_alpha__Environment.Lwt.t
(list Tezos_raw_protocol_alpha.Contract_repr.t).
Parameter delegated_balance :
context ->
Tezos_protocol_environment_alpha__Environment.Signature.Public_key_hash.t ->
Tezos_protocol_environment_alpha__Environment.Lwt.t
(Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult Tez.t).
Parameter deactivated :
context ->
Tezos_protocol_environment_alpha__Environment.Signature.Public_key_hash.t ->
Tezos_protocol_environment_alpha__Environment.Lwt.t
(Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult bool).
Parameter grace_period :
context ->
Tezos_protocol_environment_alpha__Environment.Signature.Public_key_hash.t ->
Tezos_protocol_environment_alpha__Environment.Lwt.t
(Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
Cycle.t).
End Delegate.
Module Vote.
Definition proposal :=
Tezos_protocol_environment_alpha__Environment.Protocol_hash.t.
Parameter record_proposal :
context -> Tezos_protocol_environment_alpha__Environment.Protocol_hash.t ->
public_key_hash ->
Tezos_protocol_environment_alpha__Environment.Lwt.t
(Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
context).
Parameter get_proposals :
context ->
Tezos_protocol_environment_alpha__Environment.Lwt.t
(Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
(Tezos_protocol_environment_alpha__Environment.Protocol_hash.Map.t int32)).
Parameter clear_proposals :
context -> Tezos_protocol_environment_alpha__Environment.Lwt.t context.
Parameter recorded_proposal_count_for_delegate :
context -> public_key_hash ->
Tezos_protocol_environment_alpha__Environment.Lwt.t
(Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult Z).
Parameter listings_encoding :
Tezos_protocol_environment_alpha__Environment.Data_encoding.t
(list
(Tezos_protocol_environment_alpha__Environment.Signature.Public_key_hash.t
* int32)).
Parameter freeze_listings :
context ->
Tezos_protocol_environment_alpha__Environment.Lwt.t
(Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
context).
Parameter clear_listings :
context ->
Tezos_protocol_environment_alpha__Environment.Lwt.t
(Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
context).
Parameter listing_size :
context ->
Tezos_protocol_environment_alpha__Environment.Lwt.t
(Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult int32).
Parameter in_listings :
context -> public_key_hash ->
Tezos_protocol_environment_alpha__Environment.Lwt.t bool.
Parameter get_listings :
context ->
Tezos_protocol_environment_alpha__Environment.Lwt.t
(list (public_key_hash * int32)).
Inductive ballot : Set :=
| Yay : ballot
| Nay : ballot
| Pass : ballot.
Parameter ballot_encoding :
Tezos_protocol_environment_alpha__Environment.Data_encoding.t ballot.
Module ballots.
Record record := {
yay : int32;
nay : int32;
pass : int32 }.
End ballots.
Definition ballots := ballots.record.
Parameter ballots_encoding :
Tezos_protocol_environment_alpha__Environment.Data_encoding.t ballots.
Parameter has_recorded_ballot :
context -> public_key_hash ->
Tezos_protocol_environment_alpha__Environment.Lwt.t bool.
Parameter record_ballot :
context -> public_key_hash -> ballot ->
Tezos_protocol_environment_alpha__Environment.Lwt.t
(Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
context).
Parameter get_ballots :
context ->
Tezos_protocol_environment_alpha__Environment.Lwt.t
(Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
ballots).
Parameter get_ballot_list :
context ->
Tezos_protocol_environment_alpha__Environment.Lwt.t
(list
(Tezos_protocol_environment_alpha__Environment.Signature.Public_key_hash.t
* ballot)).
Parameter clear_ballots :
context -> Tezos_protocol_environment_alpha__Environment.Lwt.t context.
Parameter get_current_period_kind :
context ->
Tezos_protocol_environment_alpha__Environment.Lwt.t
(Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
Voting_period.kind).
Parameter set_current_period_kind :
context -> Voting_period.kind ->
Tezos_protocol_environment_alpha__Environment.Lwt.t
(Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
context).
Parameter get_current_quorum :
context ->
Tezos_protocol_environment_alpha__Environment.Lwt.t
(Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult int32).
Parameter get_participation_ema :
context ->
Tezos_protocol_environment_alpha__Environment.Lwt.t
(Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult int32).
Parameter set_participation_ema :
context -> int32 ->
Tezos_protocol_environment_alpha__Environment.Lwt.t
(Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
context).
Parameter get_current_proposal :
context ->
Tezos_protocol_environment_alpha__Environment.Lwt.t
(Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
proposal).
Parameter init_current_proposal :
context -> proposal ->
Tezos_protocol_environment_alpha__Environment.Lwt.t
(Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
context).
Parameter clear_current_proposal :
context ->
Tezos_protocol_environment_alpha__Environment.Lwt.t
(Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
context).
End Vote.
Module Block_header.
Reserved Notation "'t".
Reserved Notation "'protocol_data".
Reserved Notation "'contents".
Module contents_skeleton.
Record record {priority seed_nonce_hash proof_of_work_nonce : Set} := {
priority : priority;
seed_nonce_hash : seed_nonce_hash;
proof_of_work_nonce : proof_of_work_nonce }.
Arguments record : clear implicits.
End contents_skeleton.
Definition contents_skeleton := contents_skeleton.record.
Module protocol_data_skeleton.
Record record {contents signature : Set} := {
contents : contents;
signature : signature }.
Arguments record : clear implicits.
End protocol_data_skeleton.
Definition protocol_data_skeleton := protocol_data_skeleton.record.
Module t_skeleton.
Record record {shell protocol_data : Set} := {
shell : shell;
protocol_data : protocol_data }.
Arguments record : clear implicits.
End t_skeleton.
Definition t_skeleton := t_skeleton.record.
where "'t" :=
(t_skeleton
Tezos_protocol_environment_alpha__Environment.Block_header.shell_header
'protocol_data)
and "'protocol_data" :=
(protocol_data_skeleton 'contents
Tezos_protocol_environment_alpha__Environment.Signature.t)
and "'contents" :=
(contents_skeleton Z (option Tezos_raw_protocol_alpha.Nonce_hash.t)
Tezos_protocol_environment_alpha__Environment.MBytes.t).
Definition t := 't.
Definition protocol_data := 'protocol_data.
Definition contents := 'contents.
Definition block_header := t.
Definition raw :=
Tezos_protocol_environment_alpha__Environment.Block_header.t.
Definition shell_header :=
Tezos_protocol_environment_alpha__Environment.Block_header.shell_header.
Parameter raw : block_header -> raw.
Parameter __hash_value :
block_header -> Tezos_protocol_environment_alpha__Environment.Block_hash.t.
Parameter hash_raw :
raw -> Tezos_protocol_environment_alpha__Environment.Block_hash.t.
Parameter encoding :
Tezos_protocol_environment_alpha__Environment.Data_encoding.encoding
block_header.
Parameter raw_encoding :
Tezos_protocol_environment_alpha__Environment.Data_encoding.t raw.
Parameter contents_encoding :
Tezos_protocol_environment_alpha__Environment.Data_encoding.t contents.
Parameter unsigned_encoding :
Tezos_protocol_environment_alpha__Environment.Data_encoding.t
(shell_header * contents).
Parameter protocol_data_encoding :
Tezos_protocol_environment_alpha__Environment.Data_encoding.encoding
protocol_data.
Parameter shell_header_encoding :
Tezos_protocol_environment_alpha__Environment.Data_encoding.encoding
shell_header.
Parameter max_header_length : Z.
End Block_header.
Module Kind.
Inductive seed_nonce_revelation : Set :=
| Seed_nonce_revelation_kind : seed_nonce_revelation.
Inductive double_endorsement_evidence : Set :=
| Double_endorsement_evidence_kind : double_endorsement_evidence.
Inductive double_baking_evidence : Set :=
| Double_baking_evidence_kind : double_baking_evidence.
Inductive activate_account : Set :=
| Activate_account_kind : activate_account.
Inductive endorsement : Set :=
| Endorsement_kind : endorsement.
Inductive proposals : Set :=
| Proposals_kind : proposals.
Inductive ballot : Set :=
| Ballot_kind : ballot.
Inductive reveal : Set :=
| Reveal_kind : reveal.
Inductive transaction : Set :=
| Transaction_kind : transaction.
Inductive origination : Set :=
| Origination_kind : origination.
Inductive delegation : Set :=
| Delegation_kind : delegation.
Reserved Notation "'manager".
Inductive manager_gadt : Set :=
| Reveal_manager_kind : manager_gadt
| Transaction_manager_kind : manager_gadt
| Origination_manager_kind : manager_gadt
| Delegation_manager_kind : manager_gadt
where "'manager" := (fun (a : Set) => manager_gadt).
Definition manager := 'manager.
End Kind.
Reserved Notation "'operation".
Reserved Notation "'protocol_data".
Reserved Notation "'contents_list".
Reserved Notation "'contents".
Reserved Notation "'manager_operation".
Reserved Notation "'counter".
Module protocol_data_skeleton.
Record record {contents signature : Set} := {
contents : contents;
signature : signature }.
Arguments record : clear implicits.
End protocol_data_skeleton.
Definition protocol_data_skeleton := protocol_data_skeleton.record.
Module operation_skeleton.
Record record {shell protocol_data : Set} := {
shell : shell;
protocol_data : protocol_data }.
Arguments record : clear implicits.
End operation_skeleton.
Definition operation_skeleton := operation_skeleton.record.
Inductive contents_list_gadt : Set :=
| Single : forall {kind : Set}, 'contents kind -> contents_list_gadt
| Cons : forall {kind : Set},
'contents (Kind.manager kind) -> contents_list_gadt -> contents_list_gadt
with contents_gadt : Set :=
| Endorsement : Raw_level.t -> contents_gadt
| Seed_nonce_revelation : Raw_level.t -> Nonce.t -> contents_gadt
| Double_endorsement_evidence :
'operation Kind.endorsement -> 'operation Kind.endorsement -> contents_gadt
| Double_baking_evidence : Block_header.t -> Block_header.t -> contents_gadt
| Activate_account :
Tezos_protocol_environment_alpha__Environment.Ed25519.Public_key_hash.t ->
Tezos_raw_protocol_alpha.Blinded_public_key_hash.activation_code ->
contents_gadt
| Proposals :
Tezos_protocol_environment_alpha__Environment.Signature.Public_key_hash.t ->
Voting_period.t ->
list Tezos_protocol_environment_alpha__Environment.Protocol_hash.t ->
contents_gadt
| Ballot :
Tezos_protocol_environment_alpha__Environment.Signature.Public_key_hash.t ->
Voting_period.t ->
Tezos_protocol_environment_alpha__Environment.Protocol_hash.t ->
Vote.ballot -> contents_gadt
| Manager_operation : forall {kind : Set},
Tezos_protocol_environment_alpha__Environment.Signature.Public_key_hash.t ->
Tez.tez -> 'counter -> 'manager_operation kind ->
Tezos_protocol_environment_alpha__Environment.Z.t ->
Tezos_protocol_environment_alpha__Environment.Z.t -> contents_gadt
with manager_operation_gadt : Set :=
| Reveal :
Tezos_protocol_environment_alpha__Environment.Signature.Public_key.t ->
manager_operation_gadt
| Transaction :
Tez.tez -> Script.lazy_expr -> string -> Contract.contract ->
manager_operation_gadt
| Origination :
option
Tezos_protocol_environment_alpha__Environment.Signature.Public_key_hash.t ->
Script.t -> Tez.tez -> option Contract.t -> manager_operation_gadt
| Delegation :
option
Tezos_protocol_environment_alpha__Environment.Signature.Public_key_hash.t ->
manager_operation_gadt
where "'operation" := (fun (kind : Set) =>
operation_skeleton
Tezos_protocol_environment_alpha__Environment.Operation.shell_header
('protocol_data kind))
and "'protocol_data" := (fun (kind : Set) =>
protocol_data_skeleton ('contents_list kind)
(option Tezos_protocol_environment_alpha__Environment.Signature.t))
and "'contents_list" := (fun (_ : Set) => contents_list_gadt)
and "'contents" := (fun (_ : Set) => contents_gadt)
and "'manager_operation" := (fun (_ : Set) => manager_operation_gadt)
and "'counter" := (Tezos_protocol_environment_alpha__Environment.Z.t).
Definition operation := 'operation.
Definition protocol_data := 'protocol_data.
Definition contents_list := 'contents_list.
Definition contents := 'contents.
Definition manager_operation := 'manager_operation.
Definition counter := 'counter.
Module internal_operation.
Record record {kind : Set} := {
source : Contract.contract;
operation : manager_operation kind;
nonce : Z }.
Arguments record : clear implicits.
End internal_operation.
Definition internal_operation := internal_operation.record.
Reserved Notation "'packed_manager_operation".
Inductive packed_manager_operation_gadt : Set :=
| Manager : forall {kind : Set},
manager_operation kind -> packed_manager_operation_gadt
where "'packed_manager_operation" := (packed_manager_operation_gadt).
Definition packed_manager_operation := 'packed_manager_operation.
Reserved Notation "'packed_contents".
Inductive packed_contents_gadt : Set :=
| Contents : forall {kind : Set}, contents kind -> packed_contents_gadt
where "'packed_contents" := (packed_contents_gadt).
Definition packed_contents := 'packed_contents.
Reserved Notation "'packed_contents_list".
Inductive packed_contents_list_gadt : Set :=
| Contents_list : forall {kind : Set},
contents_list kind -> packed_contents_list_gadt
where "'packed_contents_list" := (packed_contents_list_gadt).
Definition packed_contents_list := 'packed_contents_list.
Reserved Notation "'packed_protocol_data".
Inductive packed_protocol_data_gadt : Set :=
| Operation_data : forall {kind : Set},
protocol_data kind -> packed_protocol_data_gadt
where "'packed_protocol_data" := (packed_protocol_data_gadt).
Definition packed_protocol_data := 'packed_protocol_data.
Module packed_operation.
Record record := {
shell : Tezos_protocol_environment_alpha__Environment.Operation.shell_header;
protocol_data : packed_protocol_data }.
End packed_operation.
Definition packed_operation := packed_operation.record.
Reserved Notation "'packed_internal_operation".
Inductive packed_internal_operation_gadt : Set :=
| Internal_operation : forall {kind : Set},
internal_operation kind -> packed_internal_operation_gadt
where "'packed_internal_operation" := (packed_internal_operation_gadt).
Definition packed_internal_operation := 'packed_internal_operation.
Parameter manager_kind : forall {kind : Set},
manager_operation kind -> Kind.manager kind.
Module Fees.
Parameter origination_burn :
context ->
Tezos_protocol_environment_alpha__Environment.Lwt.t
(Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
(context * Tez.t)).
Parameter record_paid_storage_space :
context -> Contract.t ->
Tezos_protocol_environment_alpha__Environment.Lwt.t
(Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
(context * Tezos_protocol_environment_alpha__Environment.Z.t *
Tezos_protocol_environment_alpha__Environment.Z.t * Tez.t)).
Parameter start_counting_storage_fees : context -> context.
Parameter burn_storage_fees :
context -> Tezos_protocol_environment_alpha__Environment.Z.t ->
Contract.t ->
Tezos_protocol_environment_alpha__Environment.Lwt.t
(Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
context).
(* extensible_type Tezos_protocol_environment_alpha__Environment.Error_monad.error *)
(* extensible_type Tezos_protocol_environment_alpha__Environment.Error_monad.error *)
(* extensible_type Tezos_protocol_environment_alpha__Environment.Error_monad.error *)
Parameter check_storage_limit :
context -> Tezos_protocol_environment_alpha__Environment.Z.t ->
Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult unit.
End Fees.
Module Operation.
Definition contents (kind : Set) := contents kind.
Definition packed_contents := packed_contents.
Parameter contents_encoding :
Tezos_protocol_environment_alpha__Environment.Data_encoding.t
packed_contents.
Definition protocol_data (kind : Set) := protocol_data kind.
Definition packed_protocol_data := packed_protocol_data.
Parameter protocol_data_encoding :
Tezos_protocol_environment_alpha__Environment.Data_encoding.t
packed_protocol_data.
Parameter unsigned_encoding :
Tezos_protocol_environment_alpha__Environment.Data_encoding.t
(Tezos_protocol_environment_alpha__Environment.Operation.shell_header *
packed_contents_list).
Module raw.
Record record := {
shell :
Tezos_protocol_environment_alpha__Environment.Operation.shell_header;
proto : Tezos_protocol_environment_alpha__Environment.MBytes.t }.
End raw.
Definition raw := raw.record.
Parameter raw_encoding :
Tezos_protocol_environment_alpha__Environment.Data_encoding.t raw.
Parameter contents_list_encoding :
Tezos_protocol_environment_alpha__Environment.Data_encoding.t
packed_contents_list.
Module t.
Record record {kind : Set} := {
shell :
Tezos_protocol_environment_alpha__Environment.Operation.shell_header;
protocol_data : protocol_data kind }.
Arguments record : clear implicits.
End t.
Definition t := t.record.
Definition packed := packed_operation.
Parameter encoding :
Tezos_protocol_environment_alpha__Environment.Data_encoding.t packed.
Parameter raw : forall {A : Set}, operation A -> raw.
Parameter __hash_value : forall {A : Set},
operation A ->
Tezos_protocol_environment_alpha__Environment.Operation_hash.t.
Parameter hash_raw :
raw -> Tezos_protocol_environment_alpha__Environment.Operation_hash.t.
Parameter hash_packed :
packed_operation ->
Tezos_protocol_environment_alpha__Environment.Operation_hash.t.
Parameter acceptable_passes : packed_operation -> list Z.
(* extensible_type Tezos_protocol_environment_alpha__Environment.Error_monad.error *)
(* extensible_type Tezos_protocol_environment_alpha__Environment.Error_monad.error *)
Parameter check_signature : forall {A : Set},
public_key -> Tezos_protocol_environment_alpha__Environment.Chain_id.t ->
operation A ->
Tezos_protocol_environment_alpha__Environment.Lwt.t
(Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult unit).
Parameter check_signature_sync : forall {A : Set},
public_key -> Tezos_protocol_environment_alpha__Environment.Chain_id.t ->
operation A ->
Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult unit.
Parameter internal_operation_encoding :
Tezos_protocol_environment_alpha__Environment.Data_encoding.t
packed_internal_operation.
Parameter pack : forall {kind : Set}, operation kind -> packed_operation.
Reserved Notation "'eq".
Inductive eq_gadt : Set :=
| Eq : eq_gadt
where "'eq" := (fun (a b : Set) => eq_gadt).
Definition eq := 'eq.
Parameter equal : forall {a b : Set},
operation a -> operation b -> option (eq a b).
Module Encoding.
Reserved Notation "'case".
Inductive case_gadt : Set :=
| Case : forall {a b : Set},
Z -> string ->
Tezos_protocol_environment_alpha__Environment.Data_encoding.t a ->
(packed_contents -> option (contents b)) -> (contents b -> a) ->
(a -> contents b) -> case_gadt
where "'case" := (fun (b : Set) => case_gadt).
Definition case := 'case.
Parameter endorsement_case : case Kind.endorsement.
Parameter seed_nonce_revelation_case : case Kind.seed_nonce_revelation.
Parameter double_endorsement_evidence_case :
case Kind.double_endorsement_evidence.
Parameter double_baking_evidence_case : case Kind.double_baking_evidence.
Parameter activate_account_case : case Kind.activate_account.
Parameter proposals_case : case Kind.proposals.
Parameter ballot_case : case Kind.ballot.
Parameter reveal_case : case (Kind.manager Kind.reveal).
Parameter transaction_case : case (Kind.manager Kind.transaction).
Parameter origination_case : case (Kind.manager Kind.origination).
Parameter delegation_case : case (Kind.manager Kind.delegation).
Module Manager_operations.
Reserved Notation "'case".
Inductive case_gadt : Set :=
| MCase : forall {a kind : Set},
Z -> string ->
Tezos_protocol_environment_alpha__Environment.Data_encoding.t a ->
(packed_manager_operation -> option (manager_operation kind)) ->
(manager_operation kind -> a) -> (a -> manager_operation kind) ->
case_gadt
where "'case" := (fun (b : Set) => case_gadt).
Definition case := 'case.
Parameter reveal_case : case Kind.reveal.
Parameter transaction_case : case Kind.transaction.
Parameter origination_case : case Kind.origination.
Parameter delegation_case : case Kind.delegation.
End Manager_operations.
End Encoding.
Parameter of_list : list packed_contents -> packed_contents_list.
Parameter to_list : packed_contents_list -> list packed_contents.
End Operation.
Module Roll.
Definition t := int32.
Definition roll := t.
Parameter encoding :
Tezos_protocol_environment_alpha__Environment.Data_encoding.t roll.
Parameter snapshot_rolls :
context ->
Tezos_protocol_environment_alpha__Environment.Lwt.t
(Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
context).
Parameter cycle_end :
context -> Cycle.t ->
Tezos_protocol_environment_alpha__Environment.Lwt.t
(Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
context).
Parameter baking_rights_owner :
context -> Level.t -> Z ->
Tezos_protocol_environment_alpha__Environment.Lwt.t
(Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
public_key).
Parameter endorsement_rights_owner :
context -> Level.t -> Z ->
Tezos_protocol_environment_alpha__Environment.Lwt.t
(Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
public_key).
Parameter delegate_pubkey :
context -> public_key_hash ->
Tezos_protocol_environment_alpha__Environment.Lwt.t
(Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
public_key).
Parameter get_rolls :
context ->
Tezos_protocol_environment_alpha__Environment.Signature.Public_key_hash.t ->
Tezos_protocol_environment_alpha__Environment.Lwt.t
(Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
(list roll)).
Parameter get_change :
context ->
Tezos_protocol_environment_alpha__Environment.Signature.Public_key_hash.t ->
Tezos_protocol_environment_alpha__Environment.Lwt.t
(Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult Tez.t).
End Roll.
Module Commitment.
Module t.
Record record := {
blinded_public_key_hash :
Tezos_raw_protocol_alpha.Blinded_public_key_hash.t;
amount : Tez.tez }.
End t.
Definition t := t.record.
Parameter get_opt :
context -> Tezos_raw_protocol_alpha.Blinded_public_key_hash.t ->
Tezos_protocol_environment_alpha__Environment.Lwt.t
(Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
(option Tez.t)).
Parameter delete :
context -> Tezos_raw_protocol_alpha.Blinded_public_key_hash.t ->
Tezos_protocol_environment_alpha__Environment.Lwt.t
(Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
context).
End Commitment.
Module Bootstrap.
Parameter cycle_end :
context -> Cycle.t ->
Tezos_protocol_environment_alpha__Environment.Lwt.t
(Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
context).
End Bootstrap.
Module Global.
Parameter get_block_priority :
context ->
Tezos_protocol_environment_alpha__Environment.Lwt.t
(Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult Z).
Parameter set_block_priority :
context -> Z ->
Tezos_protocol_environment_alpha__Environment.Lwt.t
(Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
context).
End Global.
Parameter prepare_first_block :
Tezos_protocol_environment_alpha__Environment.Context.t ->
(context -> Script.t ->
Tezos_protocol_environment_alpha__Environment.Lwt.t
(Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
((Script.t * option Contract.big_map_diff) * context))) ->
Tezos_protocol_environment_alpha__Environment.Int32.t ->
Tezos_protocol_environment_alpha__Environment.Time.t -> Fitness.t ->
Tezos_protocol_environment_alpha__Environment.Lwt.t
(Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult context).
Parameter prepare :
Tezos_protocol_environment_alpha__Environment.Context.t ->
Tezos_protocol_environment_alpha__Environment.Int32.t ->
Tezos_protocol_environment_alpha__Environment.Time.t ->
Tezos_protocol_environment_alpha__Environment.Time.t -> Fitness.t ->
Tezos_protocol_environment_alpha__Environment.Lwt.t
(Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult context).
Parameter finalize :
option string -> context ->
Tezos_protocol_environment_alpha__Environment.Updater.validation_result.
Parameter activate :
context -> Tezos_protocol_environment_alpha__Environment.Protocol_hash.t ->
Tezos_protocol_environment_alpha__Environment.Lwt.t context.
Parameter fork_test_chain :
context -> Tezos_protocol_environment_alpha__Environment.Protocol_hash.t ->
Tezos_protocol_environment_alpha__Environment.Time.t ->
Tezos_protocol_environment_alpha__Environment.Lwt.t context.
Parameter record_endorsement :
context ->
Tezos_protocol_environment_alpha__Environment.Signature.Public_key_hash.t ->
context.
Parameter allowed_endorsements :
context ->
Tezos_protocol_environment_alpha__Environment.Signature.Public_key_hash.Map.t
(Tezos_protocol_environment_alpha__Environment.Signature.Public_key.t *
list Z * bool).
Parameter init_endorsements :
context ->
Tezos_protocol_environment_alpha__Environment.Signature.Public_key_hash.Map.t
(Tezos_protocol_environment_alpha__Environment.Signature.Public_key.t *
list Z * bool) -> context.
Parameter included_endorsements : context -> Z.
Parameter reset_internal_nonce : context -> context.
Parameter fresh_internal_nonce :
context ->
Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
(context * Z).
Parameter record_internal_nonce : context -> Z -> context.
Parameter internal_nonce_already_recorded : context -> Z -> bool.
Parameter add_fees :
context -> Tez.t ->
Tezos_protocol_environment_alpha__Environment.Lwt.t
(Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult context).
Parameter add_rewards :
context -> Tez.t ->
Tezos_protocol_environment_alpha__Environment.Lwt.t
(Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult context).
Parameter add_deposit :
context ->
Tezos_protocol_environment_alpha__Environment.Signature.Public_key_hash.t ->
Tez.t ->
Tezos_protocol_environment_alpha__Environment.Lwt.t
(Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult context).
Parameter get_fees : context -> Tez.t.
Parameter get_rewards : context -> Tez.t.
Parameter get_deposits :
context ->
Tezos_protocol_environment_alpha__Environment.Signature.Public_key_hash.Map.t
Tez.t.
Parameter description : Tezos_raw_protocol_alpha.Storage_description.t context.
alpha_services.ml 35 errors
(*****************************************************************************)
(* *)
(* Open Source License *)
(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com> *)
(* *)
(* Permission is hereby granted, free of charge, to any person obtaining a *)
(* copy of this software and associated documentation files (the "Software"),*)
(* to deal in the Software without restriction, including without limitation *)
(* the rights to use, copy, modify, merge, publish, distribute, sublicense, *)
(* and/or sell copies of the Software, and to permit persons to whom the *)
(* Software is furnished to do so, subject to the following conditions: *)
(* *)
(* The above copyright notice and this permission notice shall be included *)
(* in all copies or substantial portions of the Software. *)
(* *)
(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*)
(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, *)
(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL *)
(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*)
(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING *)
(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER *)
(* DEALINGS IN THE SOFTWARE. *)
(* *)
(*****************************************************************************)
open Alpha_context
let custom_root = RPC_path.open_root
module Seed = struct
module S = struct
open Data_encoding
let seed =
RPC_service.post_service
~description:"Seed of the cycle to which the block belongs."
~query:RPC_query.empty
~input:empty
~output:Seed.seed_encoding
RPC_path.(custom_root / "context" / "seed")
end
let () =
let open Services_registration in
register0 S.seed (fun ctxt () () ->
let l = Level.current ctxt in
Seed.for_cycle ctxt l.cycle)
let get ctxt block = RPC_context.make_call0 S.seed ctxt block () ()
end
module Nonce = struct
type info = Revealed of Nonce.t | Missing of Nonce_hash.t | Forgotten
let info_encoding =
let open Data_encoding in
union
[ case
(Tag 0)
~title:"Revealed"
(obj1 (req "nonce" Nonce.encoding))
(function Revealed nonce -> Some nonce | _ -> None)
(fun nonce -> Revealed nonce);
case
(Tag 1)
~title:"Missing"
(obj1 (req "hash" Nonce_hash.encoding))
(function Missing nonce -> Some nonce | _ -> None)
(fun nonce -> Missing nonce);
case
(Tag 2)
~title:"Forgotten"
empty
(function Forgotten -> Some () | _ -> None)
(fun () -> Forgotten) ]
module S = struct
let get =
RPC_service.get_service
~description:"Info about the nonce of a previous block."
~query:RPC_query.empty
~output:info_encoding
RPC_path.(custom_root / "context" / "nonces" /: Raw_level.rpc_arg)
end
let register () =
let open Services_registration in
register1 S.get (fun ctxt raw_level () () ->
let level = Level.from_raw ctxt raw_level in
Nonce.get ctxt level
>>= function
| Ok (Revealed nonce) ->
return (Revealed nonce)
| Ok (Unrevealed {nonce_hash; _}) ->
return (Missing nonce_hash)
| Error _ ->
return Forgotten)
let get ctxt block level =
RPC_context.make_call1 S.get ctxt block level () ()
end
module Contract = Contract_services
module Constants = Constants_services
module Delegate = Delegate_services
module Helpers = Helpers_services
module Forge = Helpers_services.Forge
module Parse = Helpers_services.Parse
module Voting = Voting_services
let register () =
Contract.register () ;
Constants.register () ;
Delegate.register () ;
Helpers.register () ;
Nonce.register () ;
Voting.register ()
alpha_services_ml.v
Require Import OCaml.OCaml.
Local Open Scope Z_scope.
Local Open Scope type_scope.
Import ListNotations.
Import Alpha_context.
Definition custom_root {A : Set}
: Tezos_protocol_environment_alpha__Environment.RPC_path.context A :=
RPC_path.open_root.
Module Seed.
Module S.
Import Data_encoding.
Definition seed
: Tezos_protocol_environment_alpha__Environment.RPC_service.service
(* `POST *) unit
Tezos_protocol_environment_alpha__Environment.Updater.rpc_context
Tezos_protocol_environment_alpha__Environment.Updater.rpc_context unit
unit Tezos_raw_protocol_alpha.Alpha_context.Seed.seed :=
RPC_service.post_service
(Some "Seed of the cycle to which the block belongs." % string)
RPC_query.empty empty Seed.seed_encoding
(op_div (op_div custom_root "context" % string) "seed" % string).
End S.
(* ❌ Top-level evaluations are considered as an error as sources of side-effects *)
Compute
register0 S.seed
(fun ctxt =>
fun function_parameter =>
let 'tt := function_parameter in
fun function_parameter =>
let 'tt := function_parameter in
let l := Level.current ctxt in
Seed.for_cycle ctxt
(Tezos_raw_protocol_alpha.Alpha_context.Level.t.cycle l)).
Definition get {D E G I K L a b c i o q : Set}
(ctxt :
(((Tezos_protocol_environment_alpha__Environment.RPC_service.t
((* `DELETE *) unit + (* `GET *) unit + (* `PATCH *) unit +
(* `POST *) unit + (* `PUT *) unit)
Tezos_protocol_environment_alpha__Environment.RPC_context.t
Tezos_protocol_environment_alpha__Environment.RPC_context.t q i o ->
D -> q -> i ->
Tezos_protocol_environment_alpha__Environment.Lwt.t
(Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
o)) * (E * q * i * o)) *
(((Tezos_protocol_environment_alpha__Environment.RPC_service.t
((* `DELETE *) unit + (* `GET *) unit + (* `PATCH *) unit +
(* `POST *) unit + (* `PUT *) unit)
Tezos_protocol_environment_alpha__Environment.RPC_context.t
(Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) q i
o -> D -> a -> q -> i ->
Tezos_protocol_environment_alpha__Environment.Lwt.t
(Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
o)) * (G * a * q * i * o)) *
(((Tezos_protocol_environment_alpha__Environment.RPC_service.t
((* `DELETE *) unit + (* `GET *) unit + (* `PATCH *) unit +
(* `POST *) unit + (* `PUT *) unit)
Tezos_protocol_environment_alpha__Environment.RPC_context.t
((Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) *
b) q i o -> D -> a -> b -> q -> i ->
Tezos_protocol_environment_alpha__Environment.Lwt.t
(Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
o)) * (I * a * b * q * i * o)) *
(((Tezos_protocol_environment_alpha__Environment.RPC_service.t
((* `DELETE *) unit + (* `GET *) unit + (* `PATCH *) unit +
(* `POST *) unit + (* `PUT *) unit)
Tezos_protocol_environment_alpha__Environment.RPC_context.t
(((Tezos_protocol_environment_alpha__Environment.RPC_context.t * a)
* b) * c) q i o -> D -> a -> b -> c -> q -> i ->
Tezos_protocol_environment_alpha__Environment.Lwt.t
(Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
o)) * (K * a * b * c * q * i * o)) * L)))) * L * D) (block : D)
: Tezos_protocol_environment_alpha__Environment.Lwt.t
(Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
Tezos_raw_protocol_alpha.Alpha_context.Seed.seed) :=
RPC_context.make_call0 S.seed ctxt block tt tt.
End Seed.
Module Nonce.
Inductive info : Set :=
| Revealed : Tezos_raw_protocol_alpha.Alpha_context.Nonce.t -> info
| Missing : Tezos_raw_protocol_alpha.Nonce_hash.t -> info
| Forgotten : info.
Definition info_encoding
: Tezos_protocol_environment_alpha__Environment.Data_encoding.encoding info :=
union None
(cons
(__case_value "Revealed" % string None
(Tezos_protocol_environment_alpha__Environment.Data_encoding.Tag 0)
(obj1 (req None None "nonce" % string Nonce.encoding))
(fun function_parameter =>
match function_parameter with
| Revealed nonce => Some nonce
| _ => None
end) (fun nonce => Revealed nonce))
(cons
(__case_value "Missing" % string None
(Tezos_protocol_environment_alpha__Environment.Data_encoding.Tag 1)
(obj1 (req None None "hash" % string Nonce_hash.encoding))
(fun function_parameter =>
match function_parameter with
| Missing nonce => Some nonce
| _ => None
end) (fun nonce => Missing nonce))
(cons
(__case_value "Forgotten" % string None
(Tezos_protocol_environment_alpha__Environment.Data_encoding.Tag 2)
empty
(fun function_parameter =>
match function_parameter with
| Forgotten => Some tt
| _ => None
end)
(fun function_parameter =>
let 'tt := function_parameter in
Forgotten)) []))).
Module S.
Definition get
: Tezos_protocol_environment_alpha__Environment.RPC_service.service
(* `GET *) unit
Tezos_protocol_environment_alpha__Environment.Updater.rpc_context
(Tezos_protocol_environment_alpha__Environment.Updater.rpc_context *
Tezos_raw_protocol_alpha.Alpha_context.Raw_level.raw_level) unit unit
info :=
RPC_service.get_service
(Some "Info about the nonce of a previous block." % string)
RPC_query.empty info_encoding
(op_divcolon
(op_div (op_div custom_root "context" % string) "nonces" % string)
Raw_level.rpc_arg).
End S.
Definition register (function_parameter : unit) : unit :=
let 'tt := function_parameter in
register1 S.get
(fun ctxt =>
fun raw_level =>
fun function_parameter =>
let 'tt := function_parameter in
fun function_parameter =>
let 'tt := function_parameter in
let level := Level.from_raw ctxt None raw_level in
op_gtgteq (Nonce.get ctxt level)
(fun function_parameter =>
match function_parameter with
|
Tezos_protocol_environment_alpha__Environment.Pervasives.Ok
(Tezos_raw_protocol_alpha.Alpha_context.Nonce.Revealed
nonce) => __return (Revealed nonce)
|
Tezos_protocol_environment_alpha__Environment.Pervasives.Ok
(Tezos_raw_protocol_alpha.Alpha_context.Nonce.Unrevealed
{|
Tezos_raw_protocol_alpha.Alpha_context.Nonce.unrevealed.nonce_hash :=
nonce_hash
|}) => __return (Missing nonce_hash)
|
Tezos_protocol_environment_alpha__Environment.Pervasives.Error
_ => __return Forgotten
end)).
Definition get {D E G I K L a b c i o q : Set}
(ctxt :
(((Tezos_protocol_environment_alpha__Environment.RPC_service.t
((* `DELETE *) unit + (* `GET *) unit + (* `PATCH *) unit +
(* `POST *) unit + (* `PUT *) unit)
Tezos_protocol_environment_alpha__Environment.RPC_context.t
Tezos_protocol_environment_alpha__Environment.RPC_context.t q i o ->
D -> q -> i ->
Tezos_protocol_environment_alpha__Environment.Lwt.t
(Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
o)) * (E * q * i * o)) *
(((Tezos_protocol_environment_alpha__Environment.RPC_service.t
((* `DELETE *) unit + (* `GET *) unit + (* `PATCH *) unit +
(* `POST *) unit + (* `PUT *) unit)
Tezos_protocol_environment_alpha__Environment.RPC_context.t
(Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) q i
o -> D -> a -> q -> i ->
Tezos_protocol_environment_alpha__Environment.Lwt.t
(Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
o)) * (G * a * q * i * o)) *
(((Tezos_protocol_environment_alpha__Environment.RPC_service.t
((* `DELETE *) unit + (* `GET *) unit + (* `PATCH *) unit +
(* `POST *) unit + (* `PUT *) unit)
Tezos_protocol_environment_alpha__Environment.RPC_context.t
((Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) *
b) q i o -> D -> a -> b -> q -> i ->
Tezos_protocol_environment_alpha__Environment.Lwt.t
(Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
o)) * (I * a * b * q * i * o)) *
(((Tezos_protocol_environment_alpha__Environment.RPC_service.t
((* `DELETE *) unit + (* `GET *) unit + (* `PATCH *) unit +
(* `POST *) unit + (* `PUT *) unit)
Tezos_protocol_environment_alpha__Environment.RPC_context.t
(((Tezos_protocol_environment_alpha__Environment.RPC_context.t * a)
* b) * c) q i o -> D -> a -> b -> c -> q -> i ->
Tezos_protocol_environment_alpha__Environment.Lwt.t
(Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
o)) * (K * a * b * c * q * i * o)) * L)))) * L * D) (block : D)
(level : Tezos_raw_protocol_alpha.Alpha_context.Raw_level.raw_level)
: Tezos_protocol_environment_alpha__Environment.Lwt.t
(Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
info) := RPC_context.make_call1 S.get ctxt block level tt tt.
End Nonce.
Module Contract := Contract_services.
Module Constants := Constants_services.
Module Delegate := Delegate_services.
Module Helpers := Helpers_services.
Module Forge := Helpers_services.Forge.
Module Parse := Helpers_services.Parse.
Module Voting := Voting_services.
Definition register (function_parameter : unit) : unit :=
let 'tt := function_parameter in
(* ❌ Sequences of instructions are not handled (operator ";") *)
let _ := Contract.register tt in
(* ❌ Sequences of instructions are not handled (operator ";") *)
let _ := Constants.register tt in
(* ❌ Sequences of instructions are not handled (operator ";") *)
let _ := Delegate.register tt in
(* ❌ Sequences of instructions are not handled (operator ";") *)
let _ := Helpers.register tt in
(* ❌ Sequences of instructions are not handled (operator ";") *)
let _ := Nonce.register tt in
Voting.register tt.
alpha_services.mli 34 errors
(*****************************************************************************)
(* *)
(* Open Source License *)
(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com> *)
(* *)
(* Permission is hereby granted, free of charge, to any person obtaining a *)
(* copy of this software and associated documentation files (the "Software"),*)
(* to deal in the Software without restriction, including without limitation *)
(* the rights to use, copy, modify, merge, publish, distribute, sublicense, *)
(* and/or sell copies of the Software, and to permit persons to whom the *)
(* Software is furnished to do so, subject to the following conditions: *)
(* *)
(* The above copyright notice and this permission notice shall be included *)
(* in all copies or substantial portions of the Software. *)
(* *)
(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*)
(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, *)
(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL *)
(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*)
(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING *)
(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER *)
(* DEALINGS IN THE SOFTWARE. *)
(* *)
(*****************************************************************************)
open Alpha_context
module Seed : sig
val get : 'a #RPC_context.simple -> 'a -> Seed.seed shell_tzresult Lwt.t
end
module Nonce : sig
type info = Revealed of Nonce.t | Missing of Nonce_hash.t | Forgotten
val get :
'a #RPC_context.simple -> 'a -> Raw_level.t -> info shell_tzresult Lwt.t
end
module Contract = Contract_services
module Constants = Constants_services
module Delegate = Delegate_services
module Helpers = Helpers_services
module Forge = Helpers_services.Forge
module Parse = Helpers_services.Parse
module Voting = Voting_services
val register : unit -> unit
alpha_services_mli.v
Require Import OCaml.OCaml.
Local Open Scope Z_scope.
Local Open Scope type_scope.
Import ListNotations.
Module Seed.
Parameter get : forall {E F H J K a b c i o q : Set},
(((Tezos_protocol_environment_alpha__Environment.RPC_service.t
((* `PUT *) unit + (* `GET *) unit + (* `DELETE *) unit + (* `POST *) unit
+ (* `PATCH *) unit)
Tezos_protocol_environment_alpha__Environment.RPC_context.t
Tezos_protocol_environment_alpha__Environment.RPC_context.t q i o -> a ->
q -> i ->
Tezos_protocol_environment_alpha__Environment.Lwt.t
(Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
o)) * (E * q * i * o)) *
(((Tezos_protocol_environment_alpha__Environment.RPC_service.t
((* `PUT *) unit + (* `GET *) unit + (* `DELETE *) unit +
(* `POST *) unit + (* `PATCH *) unit)
Tezos_protocol_environment_alpha__Environment.RPC_context.t
(Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) q i o
-> a -> a -> q -> i ->
Tezos_protocol_environment_alpha__Environment.Lwt.t
(Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
o)) * (F * a * q * i * o)) *
(((Tezos_protocol_environment_alpha__Environment.RPC_service.t
((* `PUT *) unit + (* `GET *) unit + (* `DELETE *) unit +
(* `POST *) unit + (* `PATCH *) unit)
Tezos_protocol_environment_alpha__Environment.RPC_context.t
((Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) * b)
q i o -> a -> a -> b -> q -> i ->
Tezos_protocol_environment_alpha__Environment.Lwt.t
(Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
o)) * (H * a * b * q * i * o)) *
(((Tezos_protocol_environment_alpha__Environment.RPC_service.t
((* `PUT *) unit + (* `GET *) unit + (* `DELETE *) unit +
(* `POST *) unit + (* `PATCH *) unit)
Tezos_protocol_environment_alpha__Environment.RPC_context.t
(((Tezos_protocol_environment_alpha__Environment.RPC_context.t * a)
* b) * c) q i o -> a -> a -> b -> c -> q -> i ->
Tezos_protocol_environment_alpha__Environment.Lwt.t
(Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
o)) * (J * a * b * c * q * i * o)) * K)))) * K * a -> a ->
Tezos_protocol_environment_alpha__Environment.Lwt.t
(Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
Tezos_raw_protocol_alpha.Alpha_context.Seed.seed).
End Seed.
Module Nonce.
Inductive info : Set :=
| Revealed : Tezos_raw_protocol_alpha.Alpha_context.Nonce.t -> info
| Missing : Tezos_raw_protocol_alpha.Nonce_hash.t -> info
| Forgotten : info.
Parameter get : forall {E F H J K a b c i o q : Set},
(((Tezos_protocol_environment_alpha__Environment.RPC_service.t
((* `PUT *) unit + (* `GET *) unit + (* `DELETE *) unit + (* `POST *) unit
+ (* `PATCH *) unit)
Tezos_protocol_environment_alpha__Environment.RPC_context.t
Tezos_protocol_environment_alpha__Environment.RPC_context.t q i o -> a ->
q -> i ->
Tezos_protocol_environment_alpha__Environment.Lwt.t
(Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
o)) * (E * q * i * o)) *
(((Tezos_protocol_environment_alpha__Environment.RPC_service.t
((* `PUT *) unit + (* `GET *) unit + (* `DELETE *) unit +
(* `POST *) unit + (* `PATCH *) unit)
Tezos_protocol_environment_alpha__Environment.RPC_context.t
(Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) q i o
-> a -> a -> q -> i ->
Tezos_protocol_environment_alpha__Environment.Lwt.t
(Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
o)) * (F * a * q * i * o)) *
(((Tezos_protocol_environment_alpha__Environment.RPC_service.t
((* `PUT *) unit + (* `GET *) unit + (* `DELETE *) unit +
(* `POST *) unit + (* `PATCH *) unit)
Tezos_protocol_environment_alpha__Environment.RPC_context.t
((Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) * b)
q i o -> a -> a -> b -> q -> i ->
Tezos_protocol_environment_alpha__Environment.Lwt.t
(Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
o)) * (H * a * b * q * i * o)) *
(((Tezos_protocol_environment_alpha__Environment.RPC_service.t
((* `PUT *) unit + (* `GET *) unit + (* `DELETE *) unit +
(* `POST *) unit + (* `PATCH *) unit)
Tezos_protocol_environment_alpha__Environment.RPC_context.t
(((Tezos_protocol_environment_alpha__Environment.RPC_context.t * a)
* b) * c) q i o -> a -> a -> b -> c -> q -> i ->
Tezos_protocol_environment_alpha__Environment.Lwt.t
(Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
o)) * (J * a * b * c * q * i * o)) * K)))) * K * a -> a ->
Tezos_raw_protocol_alpha.Alpha_context.Raw_level.t ->
Tezos_protocol_environment_alpha__Environment.Lwt.t
(Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
info).
End Nonce.
Module Contract.
(* Unhandled inlined abstract module *)
End Contract.
Module Constants.
(* Unhandled inlined abstract module *)
End Constants.
Module Delegate.
(* Unhandled inlined abstract module *)
End Delegate.
Module Helpers.
(* Unhandled inlined abstract module *)
End Helpers.
Module Forge.
(* Unhandled inlined abstract module *)
End Forge.
Module Parse.
(* Unhandled inlined abstract module *)
End Parse.
Module Voting.
(* Unhandled inlined abstract module *)
End Voting.
Parameter register : unit -> unit.
amendment.ml 17 errors
(*****************************************************************************)
(* *)
(* Open Source License *)
(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com> *)
(* *)
(* Permission is hereby granted, free of charge, to any person obtaining a *)
(* copy of this software and associated documentation files (the "Software"),*)
(* to deal in the Software without restriction, including without limitation *)
(* the rights to use, copy, modify, merge, publish, distribute, sublicense, *)
(* and/or sell copies of the Software, and to permit persons to whom the *)
(* Software is furnished to do so, subject to the following conditions: *)
(* *)
(* The above copyright notice and this permission notice shall be included *)
(* in all copies or substantial portions of the Software. *)
(* *)
(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*)
(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, *)
(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL *)
(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*)
(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING *)
(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER *)
(* DEALINGS IN THE SOFTWARE. *)
(* *)
(*****************************************************************************)
open Alpha_context
(** Returns the proposal submitted by the most delegates.
Returns None in case of a tie, if proposal quorum is below required
minimum or if there are no proposals. *)
let select_winning_proposal ctxt =
Vote.get_proposals ctxt
>>=? fun proposals ->
let merge proposal vote winners =
match winners with
| None ->
Some ([proposal], vote)
| Some (winners, winners_vote) as previous ->
if Compare.Int32.(vote = winners_vote) then
Some (proposal :: winners, winners_vote)
else if Compare.Int32.(vote > winners_vote) then Some ([proposal], vote)
else previous
in
match Protocol_hash.Map.fold merge proposals None with
| Some ([proposal], vote) ->
Vote.listing_size ctxt
>>=? fun max_vote ->
let min_proposal_quorum = Constants.min_proposal_quorum ctxt in
let min_vote_to_pass =
Int32.div (Int32.mul min_proposal_quorum max_vote) 100_00l
in
if Compare.Int32.(vote >= min_vote_to_pass) then return_some proposal
else return_none
| _ ->
return_none
(* in case of a tie, let's do nothing. *)
(** A proposal is approved if it has supermajority and the participation reaches
the current quorum.
Supermajority means the yays are more 8/10 of casted votes.
The participation is the ratio of all received votes, including passes, with
respect to the number of possible votes.
The participation EMA (exponential moving average) uses the last
participation EMA and the current participation./
The expected quorum is calculated using the last participation EMA, capped
by the min/max quorum protocol constants. *)
let check_approval_and_update_participation_ema ctxt =
Vote.get_ballots ctxt
>>=? fun ballots ->
Vote.listing_size ctxt
>>=? fun maximum_vote ->
Vote.get_participation_ema ctxt
>>=? fun participation_ema ->
Vote.get_current_quorum ctxt
>>=? fun expected_quorum ->
(* Note overflows: considering a maximum of 8e8 tokens, with roll size as
small as 1e3, there is a maximum of 8e5 rolls and thus votes.
In 'participation' an Int64 is used because in the worst case 'all_votes is
8e5 and after the multiplication is 8e9, making it potentially overflow a
signed Int32 which is 2e9. *)
let casted_votes = Int32.add ballots.yay ballots.nay in
let all_votes = Int32.add casted_votes ballots.pass in
let supermajority = Int32.div (Int32.mul 8l casted_votes) 10l in
let participation =
(* in centile of percentage *)
Int64.(
to_int32 (div (mul (of_int32 all_votes) 100_00L) (of_int32 maximum_vote)))
in
let outcome =
Compare.Int32.(
participation >= expected_quorum && ballots.yay >= supermajority)
in
let new_participation_ema =
Int32.(div (add (mul 8l participation_ema) (mul 2l participation)) 10l)
in
Vote.set_participation_ema ctxt new_participation_ema
>>=? fun ctxt -> return (ctxt, outcome)
(** Implements the state machine of the amendment procedure.
Note that [freeze_listings], that computes the vote weight of each delegate,
is run at the beginning of each voting period.
*)
let start_new_voting_period ctxt =
Vote.get_current_period_kind ctxt
>>=? function
| Proposal -> (
select_winning_proposal ctxt
>>=? fun proposal ->
Vote.clear_proposals ctxt
>>= fun ctxt ->
Vote.clear_listings ctxt
>>=? fun ctxt ->
match proposal with
| None ->
Vote.freeze_listings ctxt >>=? fun ctxt -> return ctxt
| Some proposal ->
Vote.init_current_proposal ctxt proposal
>>=? fun ctxt ->
Vote.freeze_listings ctxt
>>=? fun ctxt ->
Vote.set_current_period_kind ctxt Testing_vote
>>=? fun ctxt -> return ctxt )
| Testing_vote ->
check_approval_and_update_participation_ema ctxt
>>=? fun (ctxt, approved) ->
Vote.clear_ballots ctxt
>>= fun ctxt ->
Vote.clear_listings ctxt
>>=? fun ctxt ->
if approved then
let expiration =
(* in two days maximum... *)
Time.add
(Timestamp.current ctxt)
(Constants.test_chain_duration ctxt)
in
Vote.get_current_proposal ctxt
>>=? fun proposal ->
fork_test_chain ctxt proposal expiration
>>= fun ctxt ->
Vote.set_current_period_kind ctxt Testing >>=? fun ctxt -> return ctxt
else
Vote.clear_current_proposal ctxt
>>=? fun ctxt ->
Vote.freeze_listings ctxt
>>=? fun ctxt ->
Vote.set_current_period_kind ctxt Proposal >>=? fun ctxt -> return ctxt
| Testing ->
Vote.freeze_listings ctxt
>>=? fun ctxt ->
Vote.set_current_period_kind ctxt Promotion_vote
>>=? fun ctxt -> return ctxt
| Promotion_vote ->
check_approval_and_update_participation_ema ctxt
>>=? fun (ctxt, approved) ->
( if approved then
Vote.get_current_proposal ctxt
>>=? fun proposal -> activate ctxt proposal >>= fun ctxt -> return ctxt
else return ctxt )
>>=? fun ctxt ->
Vote.clear_ballots ctxt
>>= fun ctxt ->
Vote.clear_listings ctxt
>>=? fun ctxt ->
Vote.clear_current_proposal ctxt
>>=? fun ctxt ->
Vote.freeze_listings ctxt
>>=? fun ctxt ->
Vote.set_current_period_kind ctxt Proposal >>=? fun ctxt -> return ctxt
type error +=
| (* `Branch *)
Invalid_proposal
| Unexpected_proposal
| Unauthorized_proposal
| Too_many_proposals
| Empty_proposal
| Unexpected_ballot
| Unauthorized_ballot
let () =
let open Data_encoding in
(* Invalid proposal *)
register_error_kind
`Branch
~id:"invalid_proposal"
~title:"Invalid proposal"
~description:"Ballot provided for a proposal that is not the current one."
~pp:(fun ppf () -> Format.fprintf ppf "Invalid proposal")
empty
(function Invalid_proposal -> Some () | _ -> None)
(fun () -> Invalid_proposal) ;
(* Unexpected proposal *)
register_error_kind
`Branch
~id:"unexpected_proposal"
~title:"Unexpected proposal"
~description:"Proposal recorded outside of a proposal period."
~pp:(fun ppf () -> Format.fprintf ppf "Unexpected proposal")
empty
(function Unexpected_proposal -> Some () | _ -> None)
(fun () -> Unexpected_proposal) ;
(* Unauthorized proposal *)
register_error_kind
`Branch
~id:"unauthorized_proposal"
~title:"Unauthorized proposal"
~description:
"The delegate provided for the proposal is not in the voting listings."
~pp:(fun ppf () -> Format.fprintf ppf "Unauthorized proposal")
empty
(function Unauthorized_proposal -> Some () | _ -> None)
(fun () -> Unauthorized_proposal) ;
(* Unexpected ballot *)
register_error_kind
`Branch
~id:"unexpected_ballot"
~title:"Unexpected ballot"
~description:"Ballot recorded outside of a voting period."
~pp:(fun ppf () -> Format.fprintf ppf "Unexpected ballot")
empty
(function Unexpected_ballot -> Some () | _ -> None)
(fun () -> Unexpected_ballot) ;
(* Unauthorized ballot *)
register_error_kind
`Branch
~id:"unauthorized_ballot"
~title:"Unauthorized ballot"
~description:
"The delegate provided for the ballot is not in the voting listings."
~pp:(fun ppf () -> Format.fprintf ppf "Unauthorized ballot")
empty
(function Unauthorized_ballot -> Some () | _ -> None)
(fun () -> Unauthorized_ballot) ;
(* Too many proposals *)
register_error_kind
`Branch
~id:"too_many_proposals"
~title:"Too many proposals"
~description:
"The delegate reached the maximum number of allowed proposals."
~pp:(fun ppf () -> Format.fprintf ppf "Too many proposals")
empty
(function Too_many_proposals -> Some () | _ -> None)
(fun () -> Too_many_proposals) ;
(* Empty proposal *)
register_error_kind
`Branch
~id:"empty_proposal"
~title:"Empty proposal"
~description:"Proposal lists cannot be empty."
~pp:(fun ppf () -> Format.fprintf ppf "Empty proposal")
empty
(function Empty_proposal -> Some () | _ -> None)
(fun () -> Empty_proposal)
(* @return [true] if [List.length l] > [n] w/o computing length *)
let rec longer_than l n =
if Compare.Int.(n < 0) then assert false
else
match l with
| [] ->
false
| _ :: rest ->
if Compare.Int.(n = 0) then true
else (* n > 0 *)
longer_than rest (n - 1)
let record_proposals ctxt delegate proposals =
(match proposals with [] -> fail Empty_proposal | _ :: _ -> return_unit)
>>=? fun () ->
Vote.get_current_period_kind ctxt
>>=? function
| Proposal ->
Vote.in_listings ctxt delegate
>>= fun in_listings ->
if in_listings then
Vote.recorded_proposal_count_for_delegate ctxt delegate
>>=? fun count ->
fail_when
(longer_than proposals (Constants.max_proposals_per_delegate - count))
Too_many_proposals
>>=? fun () ->
fold_left_s
(fun ctxt proposal -> Vote.record_proposal ctxt proposal delegate)
ctxt
proposals
>>=? fun ctxt -> return ctxt
else fail Unauthorized_proposal
| Testing_vote | Testing | Promotion_vote ->
fail Unexpected_proposal
let record_ballot ctxt delegate proposal ballot =
Vote.get_current_period_kind ctxt
>>=? function
| Testing_vote | Promotion_vote ->
Vote.get_current_proposal ctxt
>>=? fun current_proposal ->
fail_unless
(Protocol_hash.equal proposal current_proposal)
Invalid_proposal
>>=? fun () ->
Vote.has_recorded_ballot ctxt delegate
>>= fun has_ballot ->
fail_when has_ballot Unauthorized_ballot
>>=? fun () ->
Vote.in_listings ctxt delegate
>>= fun in_listings ->
if in_listings then Vote.record_ballot ctxt delegate ballot
else fail Unauthorized_ballot
| Testing | Proposal ->
fail Unexpected_ballot
let last_of_a_voting_period ctxt l =
Compare.Int32.(
Int32.succ l.Level.voting_period_position
= Constants.blocks_per_voting_period ctxt)
let may_start_new_voting_period ctxt =
let level = Level.current ctxt in
if last_of_a_voting_period ctxt level then start_new_voting_period ctxt
else return ctxt
amendment_ml.v
Require Import OCaml.OCaml.
Local Open Scope Z_scope.
Local Open Scope type_scope.
Import ListNotations.
Import Alpha_context.
Definition select_winning_proposal
(ctxt : Tezos_raw_protocol_alpha__Alpha_context.context)
: Tezos_protocol_environment_alpha__Environment.Lwt.t
(Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
(option
Tezos_protocol_environment_alpha__Environment.Protocol_hash.Map.key)) :=
op_gtgteqquestion (Vote.get_proposals ctxt)
(fun proposals =>
let merge {A : Set}
(proposal : A) (vote :
Tezos_protocol_environment_alpha__Environment.Compare.Int32.t) (winners
:
option
(list A *
Tezos_protocol_environment_alpha__Environment.Compare.Int32.t))
: option
(list A *
Tezos_protocol_environment_alpha__Environment.Compare.Int32.t) :=
match winners with
| None => Some ((cons proposal []), vote)
| (Some (winners, winners_vote)) as previous =>
if op_eq vote winners_vote then
Some ((cons proposal winners), winners_vote)
else
if op_gt vote winners_vote then
Some ((cons proposal []), vote)
else
previous
end in
match Protocol_hash.Map.fold merge proposals None with
| Some (cons proposal [], vote) =>
op_gtgteqquestion (Vote.listing_size ctxt)
(fun max_vote =>
let min_proposal_quorum := Constants.min_proposal_quorum ctxt in
let min_vote_to_pass :=
Int32.div (Int32.mul min_proposal_quorum max_vote)
(* ❌ Constant of type int32 is converted to int *)
10000 in
if op_gteq vote min_vote_to_pass then
return_some proposal
else
return_none)
| _ => return_none
end).
Definition check_approval_and_update_participation_ema
(ctxt : Tezos_raw_protocol_alpha__Alpha_context.context)
: Tezos_protocol_environment_alpha__Environment.Lwt.t
(Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
(Tezos_raw_protocol_alpha__Alpha_context.context * bool)) :=
op_gtgteqquestion (Vote.get_ballots ctxt)
(fun ballots =>
op_gtgteqquestion (Vote.listing_size ctxt)
(fun maximum_vote =>
op_gtgteqquestion (Vote.get_participation_ema ctxt)
(fun participation_ema =>
op_gtgteqquestion (Vote.get_current_quorum ctxt)
(fun expected_quorum =>
let casted_votes :=
Int32.add
(Tezos_raw_protocol_alpha.Alpha_context.Vote.ballots.yay
ballots)
(Tezos_raw_protocol_alpha.Alpha_context.Vote.ballots.nay
ballots) in
let all_votes :=
Int32.add casted_votes
(Tezos_raw_protocol_alpha.Alpha_context.Vote.ballots.pass
ballots) in
let supermajority :=
Int32.div
(Int32.mul
(* ❌ Constant of type int32 is converted to int *)
8 casted_votes)
(* ❌ Constant of type int32 is converted to int *)
10 in
let participation :=
to_int32
(div
(mul (of_int32 all_votes)
(* ❌ Constant of type int64 is converted to int *)
10000) (of_int32 maximum_vote)) in
let outcome :=
op_andand (op_gteq participation expected_quorum)
(op_gteq
(Tezos_raw_protocol_alpha.Alpha_context.Vote.ballots.yay
ballots) supermajority) in
let new_participation_ema :=
div
(add
(mul
(* ❌ Constant of type int32 is converted to int *)
8 participation_ema)
(mul
(* ❌ Constant of type int32 is converted to int *)
2 participation))
(* ❌ Constant of type int32 is converted to int *)
10 in
op_gtgteqquestion
(Vote.set_participation_ema ctxt new_participation_ema)
(fun ctxt => __return (ctxt, outcome)))))).
Definition start_new_voting_period
(ctxt : Tezos_raw_protocol_alpha__Alpha_context.context)
: Tezos_protocol_environment_alpha__Environment.Lwt.t
(Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
Tezos_raw_protocol_alpha__Alpha_context.context) :=
op_gtgteqquestion (Vote.get_current_period_kind ctxt)
(fun function_parameter =>
match function_parameter with
| Tezos_raw_protocol_alpha__Alpha_context.Voting_period.Proposal =>
op_gtgteqquestion (select_winning_proposal ctxt)
(fun proposal =>
op_gtgteq (Vote.clear_proposals ctxt)
(fun ctxt =>
op_gtgteqquestion (Vote.clear_listings ctxt)
(fun ctxt =>
match proposal with
| None =>
op_gtgteqquestion (Vote.freeze_listings ctxt)
(fun ctxt => __return ctxt)
| Some proposal =>
op_gtgteqquestion
(Vote.init_current_proposal ctxt proposal)
(fun ctxt =>
op_gtgteqquestion (Vote.freeze_listings ctxt)
(fun ctxt =>
op_gtgteqquestion
(Vote.set_current_period_kind ctxt
Tezos_raw_protocol_alpha__Alpha_context.Voting_period.Testing_vote)
(fun ctxt => __return ctxt)))
end)))
| Tezos_raw_protocol_alpha__Alpha_context.Voting_period.Testing_vote =>
op_gtgteqquestion (check_approval_and_update_participation_ema ctxt)
(fun function_parameter =>
let '(ctxt, approved) := function_parameter in
op_gtgteq (Vote.clear_ballots ctxt)
(fun ctxt =>
op_gtgteqquestion (Vote.clear_listings ctxt)
(fun ctxt =>
if approved then
let expiration :=
Time.add (Timestamp.current ctxt)
(Constants.test_chain_duration ctxt) in
op_gtgteqquestion (Vote.get_current_proposal ctxt)
(fun proposal =>
op_gtgteq (fork_test_chain ctxt proposal expiration)
(fun ctxt =>
op_gtgteqquestion
(Vote.set_current_period_kind ctxt
Tezos_raw_protocol_alpha__Alpha_context.Voting_period.Testing)
(fun ctxt => __return ctxt)))
else
op_gtgteqquestion (Vote.clear_current_proposal ctxt)
(fun ctxt =>
op_gtgteqquestion (Vote.freeze_listings ctxt)
(fun ctxt =>
op_gtgteqquestion
(Vote.set_current_period_kind ctxt
Tezos_raw_protocol_alpha__Alpha_context.Voting_period.Proposal)
(fun ctxt => __return ctxt))))))
| Tezos_raw_protocol_alpha__Alpha_context.Voting_period.Testing =>
op_gtgteqquestion (Vote.freeze_listings ctxt)
(fun ctxt =>
op_gtgteqquestion
(Vote.set_current_period_kind ctxt
Tezos_raw_protocol_alpha__Alpha_context.Voting_period.Promotion_vote)
(fun ctxt => __return ctxt))
| Tezos_raw_protocol_alpha__Alpha_context.Voting_period.Promotion_vote =>
op_gtgteqquestion (check_approval_and_update_participation_ema ctxt)
(fun function_parameter =>
let '(ctxt, approved) := function_parameter in
op_gtgteqquestion
(if approved then
op_gtgteqquestion (Vote.get_current_proposal ctxt)
(fun proposal =>
op_gtgteq (activate ctxt proposal)
(fun ctxt => __return ctxt))
else
__return ctxt)
(fun ctxt =>
op_gtgteq (Vote.clear_ballots ctxt)
(fun ctxt =>
op_gtgteqquestion (Vote.clear_listings ctxt)
(fun ctxt =>
op_gtgteqquestion (Vote.clear_current_proposal ctxt)
(fun ctxt =>
op_gtgteqquestion (Vote.freeze_listings ctxt)
(fun ctxt =>
op_gtgteqquestion
(Vote.set_current_period_kind ctxt
Tezos_raw_protocol_alpha__Alpha_context.Voting_period.Proposal)
(fun ctxt => __return ctxt)))))))
end).
(* ❌ Structure item `typext` not handled. *)
type_extension
(* ❌ Top-level evaluations are considered as an error as sources of side-effects *)
Compute
(* ❌ Sequences of instructions are not handled (operator ";") *)
let _ :=
register_error_kind
(* ❌ Variants not supported *)
variant "invalid_proposal" % string "Invalid proposal" % string
"Ballot provided for a proposal that is not the current one." % string
(Some
(fun ppf =>
fun function_parameter =>
let 'tt := function_parameter in
Format.fprintf ppf
(Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Format
(Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.String_literal
"Invalid proposal" % string
Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.End_of_format)
"Invalid proposal" % string))) empty
(fun function_parameter =>
match function_parameter with
|
Tezos_protocol_environment_alpha__Environment.Error_monad.Invalid_proposal
=> Some tt
| _ => None
end)
(fun function_parameter =>
let 'tt := function_parameter in
Tezos_protocol_environment_alpha__Environment.Error_monad.Invalid_proposal)
in
(* ❌ Sequences of instructions are not handled (operator ";") *)
let _ :=
register_error_kind
(* ❌ Variants not supported *)
variant "unexpected_proposal" % string "Unexpected proposal" % string
"Proposal recorded outside of a proposal period." % string
(Some
(fun ppf =>
fun function_parameter =>
let 'tt := function_parameter in
Format.fprintf ppf
(Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Format
(Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.String_literal
"Unexpected proposal" % string
Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.End_of_format)
"Unexpected proposal" % string))) empty
(fun function_parameter =>
match function_parameter with
|
Tezos_protocol_environment_alpha__Environment.Error_monad.Unexpected_proposal
=> Some tt
| _ => None
end)
(fun function_parameter =>
let 'tt := function_parameter in
Tezos_protocol_environment_alpha__Environment.Error_monad.Unexpected_proposal)
in
(* ❌ Sequences of instructions are not handled (operator ";") *)
let _ :=
register_error_kind
(* ❌ Variants not supported *)
variant "unauthorized_proposal" % string "Unauthorized proposal" % string
"The delegate provided for the proposal is not in the voting listings." %
string
(Some
(fun ppf =>
fun function_parameter =>
let 'tt := function_parameter in
Format.fprintf ppf
(Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Format
(Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.String_literal
"Unauthorized proposal" % string
Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.End_of_format)
"Unauthorized proposal" % string))) empty
(fun function_parameter =>
match function_parameter with
|
Tezos_protocol_environment_alpha__Environment.Error_monad.Unauthorized_proposal
=> Some tt
| _ => None
end)
(fun function_parameter =>
let 'tt := function_parameter in
Tezos_protocol_environment_alpha__Environment.Error_monad.Unauthorized_proposal)
in
(* ❌ Sequences of instructions are not handled (operator ";") *)
let _ :=
register_error_kind
(* ❌ Variants not supported *)
variant "unexpected_ballot" % string "Unexpected ballot" % string
"Ballot recorded outside of a voting period." % string
(Some
(fun ppf =>
fun function_parameter =>
let 'tt := function_parameter in
Format.fprintf ppf
(Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Format
(Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.String_literal
"Unexpected ballot" % string
Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.End_of_format)
"Unexpected ballot" % string))) empty
(fun function_parameter =>
match function_parameter with
|
Tezos_protocol_environment_alpha__Environment.Error_monad.Unexpected_ballot
=> Some tt
| _ => None
end)
(fun function_parameter =>
let 'tt := function_parameter in
Tezos_protocol_environment_alpha__Environment.Error_monad.Unexpected_ballot)
in
(* ❌ Sequences of instructions are not handled (operator ";") *)
let _ :=
register_error_kind
(* ❌ Variants not supported *)
variant "unauthorized_ballot" % string "Unauthorized ballot" % string
"The delegate provided for the ballot is not in the voting listings." %
string
(Some
(fun ppf =>
fun function_parameter =>
let 'tt := function_parameter in
Format.fprintf ppf
(Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Format
(Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.String_literal
"Unauthorized ballot" % string
Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.End_of_format)
"Unauthorized ballot" % string))) empty
(fun function_parameter =>
match function_parameter with
|
Tezos_protocol_environment_alpha__Environment.Error_monad.Unauthorized_ballot
=> Some tt
| _ => None
end)
(fun function_parameter =>
let 'tt := function_parameter in
Tezos_protocol_environment_alpha__Environment.Error_monad.Unauthorized_ballot)
in
(* ❌ Sequences of instructions are not handled (operator ";") *)
let _ :=
register_error_kind
(* ❌ Variants not supported *)
variant "too_many_proposals" % string "Too many proposals" % string
"The delegate reached the maximum number of allowed proposals." % string
(Some
(fun ppf =>
fun function_parameter =>
let 'tt := function_parameter in
Format.fprintf ppf
(Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Format
(Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.String_literal
"Too many proposals" % string
Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.End_of_format)
"Too many proposals" % string))) empty
(fun function_parameter =>
match function_parameter with
|
Tezos_protocol_environment_alpha__Environment.Error_monad.Too_many_proposals
=> Some tt
| _ => None
end)
(fun function_parameter =>
let 'tt := function_parameter in
Tezos_protocol_environment_alpha__Environment.Error_monad.Too_many_proposals)
in
register_error_kind
(* ❌ Variants not supported *)
variant "empty_proposal" % string "Empty proposal" % string
"Proposal lists cannot be empty." % string
(Some
(fun ppf =>
fun function_parameter =>
let 'tt := function_parameter in
Format.fprintf ppf
(Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Format
(Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.String_literal
"Empty proposal" % string
Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.End_of_format)
"Empty proposal" % string))) empty
(fun function_parameter =>
match function_parameter with
| Tezos_protocol_environment_alpha__Environment.Error_monad.Empty_proposal
=> Some tt
| _ => None
end)
(fun function_parameter =>
let 'tt := function_parameter in
Tezos_protocol_environment_alpha__Environment.Error_monad.Empty_proposal).
Fixpoint longer_than {A : Set}
(l : list A) (n : Tezos_protocol_environment_alpha__Environment.Compare.Int.t)
: bool :=
if op_lt n 0 then
(* ❌ Assert instruction is not handled. *)
assert false
else
match l with
| [] => false
| cons _ rest =>
if op_eq n 0 then
true
else
longer_than rest (op_minus n 1)
end.
Definition record_proposals
(ctxt : Tezos_raw_protocol_alpha__Alpha_context.context)
(delegate : Tezos_raw_protocol_alpha__Alpha_context.public_key_hash)
(proposals :
list Tezos_protocol_environment_alpha__Environment.Protocol_hash.t)
: Tezos_protocol_environment_alpha__Environment.Lwt.t
(Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
Tezos_raw_protocol_alpha__Alpha_context.context) :=
op_gtgteqquestion
match proposals with
| [] =>
fail
Tezos_protocol_environment_alpha__Environment.Error_monad.Empty_proposal
| cons _ _ => return_unit
end
(fun function_parameter =>
let 'tt := function_parameter in
op_gtgteqquestion (Vote.get_current_period_kind ctxt)
(fun function_parameter =>
match function_parameter with
| Tezos_raw_protocol_alpha__Alpha_context.Voting_period.Proposal =>
op_gtgteq (Vote.in_listings ctxt delegate)
(fun in_listings =>
if in_listings then
op_gtgteqquestion
(Vote.recorded_proposal_count_for_delegate ctxt delegate)
(fun count =>
op_gtgteqquestion
(fail_when
(longer_than proposals
(op_minus Constants.max_proposals_per_delegate count))
Tezos_protocol_environment_alpha__Environment.Error_monad.Too_many_proposals)
(fun function_parameter =>
let 'tt := function_parameter in
op_gtgteqquestion
(fold_left_s
(fun ctxt =>
fun proposal =>
Vote.record_proposal ctxt proposal delegate)
ctxt proposals) (fun ctxt => __return ctxt)))
else
fail
Tezos_protocol_environment_alpha__Environment.Error_monad.Unauthorized_proposal)
|
Tezos_raw_protocol_alpha__Alpha_context.Voting_period.Testing_vote |
Tezos_raw_protocol_alpha__Alpha_context.Voting_period.Testing |
Tezos_raw_protocol_alpha__Alpha_context.Voting_period.Promotion_vote
=>
fail
Tezos_protocol_environment_alpha__Environment.Error_monad.Unexpected_proposal
end)).
Definition record_ballot
(ctxt : Tezos_raw_protocol_alpha__Alpha_context.context)
(delegate : Tezos_raw_protocol_alpha__Alpha_context.public_key_hash)
(proposal : Tezos_protocol_environment_alpha__Environment.Protocol_hash.t)
(ballot : Tezos_raw_protocol_alpha.Alpha_context.Vote.ballot)
: Tezos_protocol_environment_alpha__Environment.Lwt.t
(Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
Tezos_raw_protocol_alpha__Alpha_context.context) :=
op_gtgteqquestion (Vote.get_current_period_kind ctxt)
(fun function_parameter =>
match function_parameter with
|
Tezos_raw_protocol_alpha__Alpha_context.Voting_period.Testing_vote |
Tezos_raw_protocol_alpha__Alpha_context.Voting_period.Promotion_vote
=>
op_gtgteqquestion (Vote.get_current_proposal ctxt)
(fun current_proposal =>
op_gtgteqquestion
(fail_unless (Protocol_hash.equal proposal current_proposal)
Tezos_protocol_environment_alpha__Environment.Error_monad.Invalid_proposal)
(fun function_parameter =>
let 'tt := function_parameter in
op_gtgteq (Vote.has_recorded_ballot ctxt delegate)
(fun has_ballot =>
op_gtgteqquestion
(fail_when has_ballot
Tezos_protocol_environment_alpha__Environment.Error_monad.Unauthorized_ballot)
(fun function_parameter =>
let 'tt := function_parameter in
op_gtgteq (Vote.in_listings ctxt delegate)
(fun in_listings =>
if in_listings then
Vote.record_ballot ctxt delegate ballot
else
fail
Tezos_protocol_environment_alpha__Environment.Error_monad.Unauthorized_ballot)))))
|
Tezos_raw_protocol_alpha__Alpha_context.Voting_period.Testing |
Tezos_raw_protocol_alpha__Alpha_context.Voting_period.Proposal =>
fail
Tezos_protocol_environment_alpha__Environment.Error_monad.Unexpected_ballot
end).
Definition last_of_a_voting_period
(ctxt : Tezos_raw_protocol_alpha__Alpha_context.context)
(l : Tezos_raw_protocol_alpha.Alpha_context.Level.t) : bool :=
op_eq
(Int32.succ
(Tezos_raw_protocol_alpha.Alpha_context.Level.t.voting_period_position l))
(Constants.blocks_per_voting_period ctxt).
Definition may_start_new_voting_period
(ctxt : Tezos_raw_protocol_alpha__Alpha_context.context)
: Tezos_protocol_environment_alpha__Environment.Lwt.t
(Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
Tezos_raw_protocol_alpha__Alpha_context.context) :=
let level := Level.current ctxt in
if last_of_a_voting_period ctxt level then
start_new_voting_period ctxt
else
__return ctxt.
amendment.mli 3 errors
(*****************************************************************************)
(* *)
(* Open Source License *)
(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com> *)
(* *)
(* Permission is hereby granted, free of charge, to any person obtaining a *)
(* copy of this software and associated documentation files (the "Software"),*)
(* to deal in the Software without restriction, including without limitation *)
(* the rights to use, copy, modify, merge, publish, distribute, sublicense, *)
(* and/or sell copies of the Software, and to permit persons to whom the *)
(* Software is furnished to do so, subject to the following conditions: *)
(* *)
(* The above copyright notice and this permission notice shall be included *)
(* in all copies or substantial portions of the Software. *)
(* *)
(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*)
(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, *)
(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL *)
(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*)
(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING *)
(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER *)
(* DEALINGS IN THE SOFTWARE. *)
(* *)
(*****************************************************************************)
(**
Only delegates with at least one roll take part in the amendment procedure.
It works as follows:
- Proposal period: delegates can submit protocol amendment proposals using
the proposal operation. At the end of a proposal period, the proposal with
most supporters is selected and we move to a testing_vote period.
If there are no proposals, or a tie between proposals, a new proposal
period starts.
- Testing_vote period: delegates can cast votes to test or not the winning
proposal using the ballot operation.
At the end of a testing_vote period if participation reaches the quorum
and the proposal has a supermajority in favor, we proceed to a testing
period. Otherwise we go back to a proposal period.
In any case, if there is enough participation the quorum is updated.
- Testing period: a test chain is forked for the lengh of the period.
At the end of a testing period we move to a promotion_vote period.
- Promotion_vote period: delegates can cast votes to promote or not the
tested proposal using the ballot operation.
At the end of a promotion_vote period if participation reaches the quorum
and the tested proposal has a supermajority in favor, it is activated as
the new protocol. Otherwise we go back to a proposal period.
In any case, if there is enough participation the quorum is updated.
*)
open Alpha_context
(** If at the end of a voting period, moves to the next one following
the state machine of the amendment procedure. *)
val may_start_new_voting_period : context -> context tzresult Lwt.t
type error +=
| Unexpected_proposal
| Unauthorized_proposal
| Too_many_proposals
| Empty_proposal
(** Records a list of proposals for a delegate.
@raise Unexpected_proposal if [ctxt] is not in a proposal period.
@raise Unauthorized_proposal if [delegate] is not in the listing. *)
val record_proposals :
context -> public_key_hash -> Protocol_hash.t list -> context tzresult Lwt.t
type error += Invalid_proposal | Unexpected_ballot | Unauthorized_ballot
val record_ballot :
context ->
public_key_hash ->
Protocol_hash.t ->
Vote.ballot ->
context tzresult Lwt.t
amendment_mli.v
Require Import OCaml.OCaml.
Local Open Scope Z_scope.
Local Open Scope type_scope.
Import ListNotations.
Parameter may_start_new_voting_period :
Tezos_raw_protocol_alpha.Alpha_context.context ->
Tezos_protocol_environment_alpha__Environment.Lwt.t
(Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
Tezos_raw_protocol_alpha.Alpha_context.context).
(* extensible_type Tezos_protocol_environment_alpha__Environment.Error_monad.error *)
Parameter record_proposals :
Tezos_raw_protocol_alpha.Alpha_context.context ->
Tezos_raw_protocol_alpha.Alpha_context.public_key_hash ->
list Tezos_protocol_environment_alpha__Environment.Protocol_hash.t ->
Tezos_protocol_environment_alpha__Environment.Lwt.t
(Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
Tezos_raw_protocol_alpha.Alpha_context.context).
(* extensible_type Tezos_protocol_environment_alpha__Environment.Error_monad.error *)
Parameter record_ballot :
Tezos_raw_protocol_alpha.Alpha_context.context ->
Tezos_raw_protocol_alpha.Alpha_context.public_key_hash ->
Tezos_protocol_environment_alpha__Environment.Protocol_hash.t ->
Tezos_raw_protocol_alpha.Alpha_context.Vote.ballot ->
Tezos_protocol_environment_alpha__Environment.Lwt.t
(Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
Tezos_raw_protocol_alpha.Alpha_context.context).
apply.ml 85 errors
(*****************************************************************************)
(* *)
(* Open Source License *)
(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com> *)
(* *)
(* Permission is hereby granted, free of charge, to any person obtaining a *)
(* copy of this software and associated documentation files (the "Software"),*)
(* to deal in the Software without restriction, including without limitation *)
(* the rights to use, copy, modify, merge, publish, distribute, sublicense, *)
(* and/or sell copies of the Software, and to permit persons to whom the *)
(* Software is furnished to do so, subject to the following conditions: *)
(* *)
(* The above copyright notice and this permission notice shall be included *)
(* in all copies or substantial portions of the Software. *)
(* *)
(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*)
(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, *)
(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL *)
(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*)
(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING *)
(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER *)
(* DEALINGS IN THE SOFTWARE. *)
(* *)
(*****************************************************************************)
(** Tezos Protocol Implementation - Main Entry Points *)
open Alpha_context
type error += Wrong_voting_period of Voting_period.t * Voting_period.t
(* `Temporary *)
type error += Wrong_endorsement_predecessor of Block_hash.t * Block_hash.t
(* `Temporary *)
type error += Duplicate_endorsement of Signature.Public_key_hash.t
(* `Branch *)
type error += Invalid_endorsement_level
type error += Invalid_commitment of {expected : bool}
type error += Internal_operation_replay of packed_internal_operation
type error += Invalid_double_endorsement_evidence (* `Permanent *)
type error +=
| Inconsistent_double_endorsement_evidence of {
delegate1 : Signature.Public_key_hash.t;
delegate2 : Signature.Public_key_hash.t;
}
(* `Permanent *)
type error += Unrequired_double_endorsement_evidence (* `Branch*)
type error +=
| Too_early_double_endorsement_evidence of {
level : Raw_level.t;
current : Raw_level.t;
}
(* `Temporary *)
type error +=
| Outdated_double_endorsement_evidence of {
level : Raw_level.t;
last : Raw_level.t;
}
(* `Permanent *)
type error +=
| Invalid_double_baking_evidence of {
hash1 : Block_hash.t;
level1 : Int32.t;
hash2 : Block_hash.t;
level2 : Int32.t;
}
(* `Permanent *)
type error +=
| Inconsistent_double_baking_evidence of {
delegate1 : Signature.Public_key_hash.t;
delegate2 : Signature.Public_key_hash.t;
}
(* `Permanent *)
type error += Unrequired_double_baking_evidence (* `Branch*)
type error +=
| Too_early_double_baking_evidence of {
level : Raw_level.t;
current : Raw_level.t;
}
(* `Temporary *)
type error +=
| Outdated_double_baking_evidence of {
level : Raw_level.t;
last : Raw_level.t;
}
(* `Permanent *)
type error += Invalid_activation of {pkh : Ed25519.Public_key_hash.t}
type error += Multiple_revelation
type error += Gas_quota_exceeded_init_deserialize (* Permanent *)
type error +=
| Not_enough_endorsements_for_priority of {
required : int;
priority : int;
endorsements : int;
timestamp : Time.t;
}
let () =
register_error_kind
`Temporary
~id:"operation.wrong_endorsement_predecessor"
~title:"Wrong endorsement predecessor"
~description:
"Trying to include an endorsement in a block that is not the successor \
of the endorsed one"
~pp:(fun ppf (e, p) ->
Format.fprintf
ppf
"Wrong predecessor %a, expected %a"
Block_hash.pp
p
Block_hash.pp
e)
Data_encoding.(
obj2
(req "expected" Block_hash.encoding)
(req "provided" Block_hash.encoding))
(function
| Wrong_endorsement_predecessor (e, p) -> Some (e, p) | _ -> None)
(fun (e, p) -> Wrong_endorsement_predecessor (e, p)) ;
register_error_kind
`Temporary
~id:"operation.wrong_voting_period"
~title:"Wrong voting period"
~description:
"Trying to onclude a proposal or ballot meant for another voting period"
~pp:(fun ppf (e, p) ->
Format.fprintf
ppf
"Wrong voting period %a, current is %a"
Voting_period.pp
p
Voting_period.pp
e)
Data_encoding.(
obj2
(req "current" Voting_period.encoding)
(req "provided" Voting_period.encoding))
(function Wrong_voting_period (e, p) -> Some (e, p) | _ -> None)
(fun (e, p) -> Wrong_voting_period (e, p)) ;
register_error_kind
`Branch
~id:"operation.duplicate_endorsement"
~title:"Duplicate endorsement"
~description:"Two endorsements received from same delegate"
~pp:(fun ppf k ->
Format.fprintf
ppf
"Duplicate endorsement from delegate %a (possible replay attack)."
Signature.Public_key_hash.pp_short
k)
Data_encoding.(obj1 (req "delegate" Signature.Public_key_hash.encoding))
(function Duplicate_endorsement k -> Some k | _ -> None)
(fun k -> Duplicate_endorsement k) ;
register_error_kind
`Temporary
~id:"operation.invalid_endorsement_level"
~title:"Unexpected level in endorsement"
~description:
"The level of an endorsement is inconsistent with the provided block \
hash."
~pp:(fun ppf () -> Format.fprintf ppf "Unexpected level in endorsement.")
Data_encoding.unit
(function Invalid_endorsement_level -> Some () | _ -> None)
(fun () -> Invalid_endorsement_level) ;
register_error_kind
`Permanent
~id:"block.invalid_commitment"
~title:"Invalid commitment in block header"
~description:"The block header has invalid commitment."
~pp:(fun ppf expected ->
if expected then
Format.fprintf ppf "Missing seed's nonce commitment in block header."
else
Format.fprintf
ppf
"Unexpected seed's nonce commitment in block header.")
Data_encoding.(obj1 (req "expected" bool))
(function Invalid_commitment {expected} -> Some expected | _ -> None)
(fun expected -> Invalid_commitment {expected}) ;
register_error_kind
`Permanent
~id:"internal_operation_replay"
~title:"Internal operation replay"
~description:"An internal operation was emitted twice by a script"
~pp:(fun ppf (Internal_operation {nonce; _}) ->
Format.fprintf
ppf
"Internal operation %d was emitted twice by a script"
nonce)
Operation.internal_operation_encoding
(function Internal_operation_replay op -> Some op | _ -> None)
(fun op -> Internal_operation_replay op) ;
register_error_kind
`Permanent
~id:"block.invalid_double_endorsement_evidence"
~title:"Invalid double endorsement evidence"
~description:"A double-endorsement evidence is malformed"
~pp:(fun ppf () ->
Format.fprintf ppf "Malformed double-endorsement evidence")
Data_encoding.empty
(function Invalid_double_endorsement_evidence -> Some () | _ -> None)
(fun () -> Invalid_double_endorsement_evidence) ;
register_error_kind
`Permanent
~id:"block.inconsistent_double_endorsement_evidence"
~title:"Inconsistent double endorsement evidence"
~description:
"A double-endorsement evidence is inconsistent (two distinct delegates)"
~pp:(fun ppf (delegate1, delegate2) ->
Format.fprintf
ppf
"Inconsistent double-endorsement evidence (distinct delegate: %a and \
%a)"
Signature.Public_key_hash.pp_short
delegate1
Signature.Public_key_hash.pp_short
delegate2)
Data_encoding.(
obj2
(req "delegate1" Signature.Public_key_hash.encoding)
(req "delegate2" Signature.Public_key_hash.encoding))
(function
| Inconsistent_double_endorsement_evidence {delegate1; delegate2} ->
Some (delegate1, delegate2)
| _ ->
None)
(fun (delegate1, delegate2) ->
Inconsistent_double_endorsement_evidence {delegate1; delegate2}) ;
register_error_kind
`Branch
~id:"block.unrequired_double_endorsement_evidence"
~title:"Unrequired double endorsement evidence"
~description:"A double-endorsement evidence is unrequired"
~pp:(fun ppf () ->
Format.fprintf
ppf
"A valid double-endorsement operation cannot be applied: the \
associated delegate has previously been denunciated in this cycle.")
Data_encoding.empty
(function Unrequired_double_endorsement_evidence -> Some () | _ -> None)
(fun () -> Unrequired_double_endorsement_evidence) ;
register_error_kind
`Temporary
~id:"block.too_early_double_endorsement_evidence"
~title:"Too early double endorsement evidence"
~description:"A double-endorsement evidence is in the future"
~pp:(fun ppf (level, current) ->
Format.fprintf
ppf
"A double-endorsement evidence is in the future (current level: %a, \
endorsement level: %a)"
Raw_level.pp
current
Raw_level.pp
level)
Data_encoding.(
obj2 (req "level" Raw_level.encoding) (req "current" Raw_level.encoding))
(function
| Too_early_double_endorsement_evidence {level; current} ->
Some (level, current)
| _ ->
None)
(fun (level, current) ->
Too_early_double_endorsement_evidence {level; current}) ;
register_error_kind
`Permanent
~id:"block.outdated_double_endorsement_evidence"
~title:"Outdated double endorsement evidence"
~description:"A double-endorsement evidence is outdated."
~pp:(fun ppf (level, last) ->
Format.fprintf
ppf
"A double-endorsement evidence is outdated (last acceptable level: \
%a, endorsement level: %a)"
Raw_level.pp
last
Raw_level.pp
level)
Data_encoding.(
obj2 (req "level" Raw_level.encoding) (req "last" Raw_level.encoding))
(function
| Outdated_double_endorsement_evidence {level; last} ->
Some (level, last)
| _ ->
None)
(fun (level, last) -> Outdated_double_endorsement_evidence {level; last}) ;
register_error_kind
`Permanent
~id:"block.invalid_double_baking_evidence"
~title:"Invalid double baking evidence"
~description:
"A double-baking evidence is inconsistent (two distinct level)"
~pp:(fun ppf (hash1, level1, hash2, level2) ->
Format.fprintf
ppf
"Invalid double-baking evidence (hash: %a and %a, levels: %ld and %ld)"
Block_hash.pp
hash1
Block_hash.pp
hash2
level1
level2)
Data_encoding.(
obj4
(req "hash1" Block_hash.encoding)
(req "level1" int32)
(req "hash2" Block_hash.encoding)
(req "level2" int32))
(function
| Invalid_double_baking_evidence {hash1; level1; hash2; level2} ->
Some (hash1, level1, hash2, level2)
| _ ->
None)
(fun (hash1, level1, hash2, level2) ->
Invalid_double_baking_evidence {hash1; level1; hash2; level2}) ;
register_error_kind
`Permanent
~id:"block.inconsistent_double_baking_evidence"
~title:"Inconsistent double baking evidence"
~description:
"A double-baking evidence is inconsistent (two distinct delegates)"
~pp:(fun ppf (delegate1, delegate2) ->
Format.fprintf
ppf
"Inconsistent double-baking evidence (distinct delegate: %a and %a)"
Signature.Public_key_hash.pp_short
delegate1
Signature.Public_key_hash.pp_short
delegate2)
Data_encoding.(
obj2
(req "delegate1" Signature.Public_key_hash.encoding)
(req "delegate2" Signature.Public_key_hash.encoding))
(function
| Inconsistent_double_baking_evidence {delegate1; delegate2} ->
Some (delegate1, delegate2)
| _ ->
None)
(fun (delegate1, delegate2) ->
Inconsistent_double_baking_evidence {delegate1; delegate2}) ;
register_error_kind
`Branch
~id:"block.unrequired_double_baking_evidence"
~title:"Unrequired double baking evidence"
~description:"A double-baking evidence is unrequired"
~pp:(fun ppf () ->
Format.fprintf
ppf
"A valid double-baking operation cannot be applied: the associated \
delegate has previously been denunciated in this cycle.")
Data_encoding.empty
(function Unrequired_double_baking_evidence -> Some () | _ -> None)
(fun () -> Unrequired_double_baking_evidence) ;
register_error_kind
`Temporary
~id:"block.too_early_double_baking_evidence"
~title:"Too early double baking evidence"
~description:"A double-baking evidence is in the future"
~pp:(fun ppf (level, current) ->
Format.fprintf
ppf
"A double-baking evidence is in the future (current level: %a, \
baking level: %a)"
Raw_level.pp
current
Raw_level.pp
level)
Data_encoding.(
obj2 (req "level" Raw_level.encoding) (req "current" Raw_level.encoding))
(function
| Too_early_double_baking_evidence {level; current} ->
Some (level, current)
| _ ->
None)
(fun (level, current) -> Too_early_double_baking_evidence {level; current}) ;
register_error_kind
`Permanent
~id:"block.outdated_double_baking_evidence"
~title:"Outdated double baking evidence"
~description:"A double-baking evidence is outdated."
~pp:(fun ppf (level, last) ->
Format.fprintf
ppf
"A double-baking evidence is outdated (last acceptable level: %a, \
baking level: %a)"
Raw_level.pp
last
Raw_level.pp
level)
Data_encoding.(
obj2 (req "level" Raw_level.encoding) (req "last" Raw_level.encoding))
(function
| Outdated_double_baking_evidence {level; last} ->
Some (level, last)
| _ ->
None)
(fun (level, last) -> Outdated_double_baking_evidence {level; last}) ;
register_error_kind
`Permanent
~id:"operation.invalid_activation"
~title:"Invalid activation"
~description:
"The given key and secret do not correspond to any existing \
preallocated contract"
~pp:(fun ppf pkh ->
Format.fprintf
ppf
"Invalid activation. The public key %a does not match any commitment."
Ed25519.Public_key_hash.pp
pkh)
Data_encoding.(obj1 (req "pkh" Ed25519.Public_key_hash.encoding))
(function Invalid_activation {pkh} -> Some pkh | _ -> None)
(fun pkh -> Invalid_activation {pkh}) ;
register_error_kind
`Permanent
~id:"block.multiple_revelation"
~title:"Multiple revelations were included in a manager operation"
~description:
"A manager operation should not contain more than one revelation"
~pp:(fun ppf () ->
Format.fprintf
ppf
"Multiple revelations were included in a manager operation")
Data_encoding.empty
(function Multiple_revelation -> Some () | _ -> None)
(fun () -> Multiple_revelation) ;
register_error_kind
`Permanent
~id:"gas_exhausted.init_deserialize"
~title:"Not enough gas for initial deserialization of script expresions"
~description:
"Gas limit was not high enough to deserialize the transaction \
parameters or origination script code or initial storage, making the \
operation impossible to parse within the provided gas bounds."
Data_encoding.empty
(function Gas_quota_exceeded_init_deserialize -> Some () | _ -> None)
(fun () -> Gas_quota_exceeded_init_deserialize) ;
register_error_kind
`Permanent
~id:"operation.not_enought_endorsements_for_priority"
~title:"Not enough endorsements for priority"
~description:
"The block being validated does not include the required minimum number \
of endorsements for this priority."
~pp:(fun ppf (required, endorsements, priority, timestamp) ->
Format.fprintf
ppf
"Wrong number of endorsements (%i) for priority (%i), %i are expected \
at %a"
endorsements
priority
required
Time.pp_hum
timestamp)
Data_encoding.(
obj4
(req "required" int31)
(req "endorsements" int31)
(req "priority" int31)
(req "timestamp" Time.encoding))
(function
| Not_enough_endorsements_for_priority
{required; endorsements; priority; timestamp} ->
Some (required, endorsements, priority, timestamp)
| _ ->
None)
(fun (required, endorsements, priority, timestamp) ->
Not_enough_endorsements_for_priority
{required; endorsements; priority; timestamp})
open Apply_results
let apply_manager_operation_content :
type kind.
Alpha_context.t ->
Script_ir_translator.unparsing_mode ->
payer:Contract.t ->
source:Contract.t ->
chain_id:Chain_id.t ->
internal:bool ->
kind manager_operation ->
( context
* kind successful_manager_operation_result
* packed_internal_operation list )
tzresult
Lwt.t =
fun ctxt mode ~payer ~source ~chain_id ~internal operation ->
let before_operation =
(* This context is not used for backtracking. Only to compute
gas consumption and originations for the operation result. *)
ctxt
in
Contract.must_exist ctxt source
>>=? fun () ->
Lwt.return (Gas.consume ctxt Michelson_v1_gas.Cost_of.manager_operation)
>>=? fun ctxt ->
match operation with
| Reveal _ ->
return
(* No-op: action already performed by `precheck_manager_contents`. *)
( ctxt,
( Reveal_result
{consumed_gas = Gas.consumed ~since:before_operation ~until:ctxt}
: kind successful_manager_operation_result ),
[] )
| Transaction {amount; parameters; destination; entrypoint} -> (
Contract.spend ctxt source amount
>>=? fun ctxt ->
( match Contract.is_implicit destination with
| None ->
return (ctxt, [], false)
| Some _ -> (
Contract.allocated ctxt destination
>>=? function
| true ->
return (ctxt, [], false)
| false ->
Fees.origination_burn ctxt
>>=? fun (ctxt, origination_burn) ->
return
( ctxt,
[(Delegate.Contract payer, Delegate.Debited origination_burn)],
true ) ) )
>>=? fun (ctxt, maybe_burn_balance_update, allocated_destination_contract)
->
Contract.credit ctxt destination amount
>>=? fun ctxt ->
Contract.get_script ctxt destination
>>=? fun (ctxt, script) ->
match script with
| None ->
( match entrypoint with
| "default" ->
return ()
| entrypoint ->
fail (Script_tc_errors.No_such_entrypoint entrypoint) )
>>=? (fun () ->
Script.force_decode ctxt parameters
>>=? fun (arg, ctxt) ->
(* see [note] *)
(* [note]: for toplevel ops, cost is nil since the
lazy value has already been forced at precheck, so
we compute and consume the full cost again *)
let cost_arg = Script.deserialized_cost arg in
Lwt.return (Gas.consume ctxt cost_arg)
>>=? fun ctxt ->
match Micheline.root arg with
| Prim (_, D_Unit, [], _) ->
(* Allow [Unit] parameter to non-scripted contracts. *)
return ctxt
| _ ->
fail
(Script_interpreter.Bad_contract_parameter destination))
>>=? fun ctxt ->
let result =
Transaction_result
{
storage = None;
big_map_diff = None;
balance_updates =
Delegate.cleanup_balance_updates
( [ (Delegate.Contract source, Delegate.Debited amount);
(Contract destination, Credited amount) ]
@ maybe_burn_balance_update );
originated_contracts = [];
consumed_gas = Gas.consumed ~since:before_operation ~until:ctxt;
storage_size = Z.zero;
paid_storage_size_diff = Z.zero;
allocated_destination_contract;
}
in
return (ctxt, result, [])
| Some script ->
Script.force_decode ctxt parameters
>>=? fun (parameter, ctxt) ->
(* see [note] *)
let cost_parameter = Script.deserialized_cost parameter in
Lwt.return (Gas.consume ctxt cost_parameter)
>>=? fun ctxt ->
let step_constants =
let open Script_interpreter in
{source; payer; self = destination; amount; chain_id}
in
Script_interpreter.execute
ctxt
mode
step_constants
~script
~parameter
~entrypoint
>>=? fun {ctxt; storage; big_map_diff; operations} ->
Contract.update_script_storage ctxt destination storage big_map_diff
>>=? fun ctxt ->
Fees.record_paid_storage_space ctxt destination
>>=? fun (ctxt, new_size, paid_storage_size_diff, fees) ->
Contract.originated_from_current_nonce
~since:before_operation
~until:ctxt
>>=? fun originated_contracts ->
let result =
Transaction_result
{
storage = Some storage;
big_map_diff;
balance_updates =
Delegate.cleanup_balance_updates
[ (Contract payer, Debited fees);
(Contract source, Debited amount);
(Contract destination, Credited amount) ];
originated_contracts;
consumed_gas = Gas.consumed ~since:before_operation ~until:ctxt;
storage_size = new_size;
paid_storage_size_diff;
allocated_destination_contract;
}
in
return (ctxt, result, operations) )
| Origination {delegate; script; preorigination; credit} ->
Script.force_decode ctxt script.storage
>>=? fun (unparsed_storage, ctxt) ->
(* see [note] *)
Lwt.return (Gas.consume ctxt (Script.deserialized_cost unparsed_storage))
>>=? fun ctxt ->
Script.force_decode ctxt script.code
>>=? fun (unparsed_code, ctxt) ->
(* see [note] *)
Lwt.return (Gas.consume ctxt (Script.deserialized_cost unparsed_code))
>>=? fun ctxt ->
Script_ir_translator.parse_script ctxt ~legacy:false script
>>=? fun (Ex_script parsed_script, ctxt) ->
Script_ir_translator.collect_big_maps
ctxt
parsed_script.storage_type
parsed_script.storage
>>=? fun (to_duplicate, ctxt) ->
let to_update = Script_ir_translator.no_big_map_id in
Script_ir_translator.extract_big_map_diff
ctxt
Optimized
parsed_script.storage_type
parsed_script.storage
~to_duplicate
~to_update
~temporary:false
>>=? fun (storage, big_map_diff, ctxt) ->
Script_ir_translator.unparse_data
ctxt
Optimized
parsed_script.storage_type
storage
>>=? fun (storage, ctxt) ->
let storage = Script.lazy_expr (Micheline.strip_locations storage) in
let script = {script with storage} in
Contract.spend ctxt source credit
>>=? fun ctxt ->
( match preorigination with
| Some contract ->
assert internal ;
(* The preorigination field is only used to early return
the address of an originated contract in Michelson.
It cannot come from the outside. *)
return (ctxt, contract)
| None ->
Contract.fresh_contract_from_current_nonce ctxt )
>>=? fun (ctxt, contract) ->
Contract.originate
ctxt
contract
~delegate
~balance:credit
~script:(script, big_map_diff)
>>=? fun ctxt ->
Fees.origination_burn ctxt
>>=? fun (ctxt, origination_burn) ->
Fees.record_paid_storage_space ctxt contract
>>=? fun (ctxt, size, paid_storage_size_diff, fees) ->
let result =
Origination_result
{
big_map_diff;
balance_updates =
Delegate.cleanup_balance_updates
[ (Contract payer, Debited fees);
(Contract payer, Debited origination_burn);
(Contract source, Debited credit);
(Contract contract, Credited credit) ];
originated_contracts = [contract];
consumed_gas = Gas.consumed ~since:before_operation ~until:ctxt;
storage_size = size;
paid_storage_size_diff;
}
in
return (ctxt, result, [])
| Delegation delegate ->
Delegate.set ctxt source delegate
>>=? fun ctxt ->
return
( ctxt,
Delegation_result
{consumed_gas = Gas.consumed ~since:before_operation ~until:ctxt},
[] )
let apply_internal_manager_operations ctxt mode ~payer ~chain_id ops =
let rec apply ctxt applied worklist =
match worklist with
| [] ->
Lwt.return (`Success ctxt, List.rev applied)
| Internal_operation ({source; operation; nonce} as op) :: rest -> (
( if internal_nonce_already_recorded ctxt nonce then
fail (Internal_operation_replay (Internal_operation op))
else
let ctxt = record_internal_nonce ctxt nonce in
apply_manager_operation_content
ctxt
mode
~source
~payer
~chain_id
~internal:true
operation )
>>= function
| Error errors ->
let result =
Internal_operation_result
(op, Failed (manager_kind op.operation, errors))
in
let skipped =
List.rev_map
(fun (Internal_operation op) ->
Internal_operation_result
(op, Skipped (manager_kind op.operation)))
rest
in
Lwt.return (`Failure, List.rev (skipped @ (result :: applied)))
| Ok (ctxt, result, emitted) ->
apply
ctxt
(Internal_operation_result (op, Applied result) :: applied)
(rest @ emitted) )
in
apply ctxt [] ops
let precheck_manager_contents (type kind) ctxt chain_id raw_operation
(op : kind Kind.manager contents) : context tzresult Lwt.t =
let (Manager_operation
{source; fee; counter; operation; gas_limit; storage_limit}) =
op
in
Lwt.return (Gas.check_limit ctxt gas_limit)
>>=? fun () ->
let ctxt = Gas.set_limit ctxt gas_limit in
Lwt.return (Fees.check_storage_limit ctxt storage_limit)
>>=? fun () ->
Contract.must_be_allocated ctxt (Contract.implicit_contract source)
>>=? fun () ->
Contract.check_counter_increment ctxt source counter
>>=? fun () ->
( match operation with
| Reveal pk ->
Contract.reveal_manager_key ctxt source pk
| Transaction {parameters; _} ->
(* Fail quickly if not enough gas for minimal deserialization cost *)
Lwt.return
@@ record_trace Gas_quota_exceeded_init_deserialize
@@ Gas.check_enough ctxt (Script.minimal_deserialize_cost parameters)
>>=? fun () ->
(* Fail if not enough gas for complete deserialization cost *)
trace Gas_quota_exceeded_init_deserialize
@@ Script.force_decode ctxt parameters
>>|? fun (_arg, ctxt) -> ctxt
| Origination {script; _} ->
(* Fail quickly if not enough gas for minimal deserialization cost *)
Lwt.return
@@ record_trace Gas_quota_exceeded_init_deserialize
@@ ( Gas.consume ctxt (Script.minimal_deserialize_cost script.code)
>>? fun ctxt ->
Gas.check_enough ctxt (Script.minimal_deserialize_cost script.storage)
)
>>=? fun () ->
(* Fail if not enough gas for complete deserialization cost *)
trace Gas_quota_exceeded_init_deserialize
@@ Script.force_decode ctxt script.code
>>=? fun (_code, ctxt) ->
trace Gas_quota_exceeded_init_deserialize
@@ Script.force_decode ctxt script.storage
>>|? fun (_storage, ctxt) -> ctxt
| _ ->
return ctxt )
>>=? fun ctxt ->
Contract.get_manager_key ctxt source
>>=? fun public_key ->
(* Currently, the `raw_operation` only contains one signature, so
all operations are required to be from the same manager. This may
change in the future, allowing several managers to group-sign a
sequence of transactions. *)
Operation.check_signature public_key chain_id raw_operation
>>=? fun () ->
Contract.increment_counter ctxt source
>>=? fun ctxt ->
Contract.spend ctxt (Contract.implicit_contract source) fee
>>=? fun ctxt -> add_fees ctxt fee >>=? fun ctxt -> return ctxt
let apply_manager_contents (type kind) ctxt mode chain_id
(op : kind Kind.manager contents) :
( [`Success of context | `Failure]
* kind manager_operation_result
* packed_internal_operation_result list )
Lwt.t =
let (Manager_operation {source; operation; gas_limit; storage_limit}) = op in
let ctxt = Gas.set_limit ctxt gas_limit in
let ctxt = Fees.start_counting_storage_fees ctxt in
let source = Contract.implicit_contract source in
apply_manager_operation_content
ctxt
mode
~source
~payer:source
~internal:false
~chain_id
operation
>>= function
| Ok (ctxt, operation_results, internal_operations) -> (
apply_internal_manager_operations
ctxt
mode
~payer:source
~chain_id
internal_operations
>>= function
| (`Success ctxt, internal_operations_results) -> (
Fees.burn_storage_fees ctxt ~storage_limit ~payer:source
>>= function
| Ok ctxt ->
Lwt.return
( `Success ctxt,
Applied operation_results,
internal_operations_results )
| Error errors ->
Lwt.return
( `Failure,
Backtracked (operation_results, Some errors),
internal_operations_results ) )
| (`Failure, internal_operations_results) ->
Lwt.return
(`Failure, Applied operation_results, internal_operations_results)
)
| Error errors ->
Lwt.return (`Failure, Failed (manager_kind operation, errors), [])
let skipped_operation_result :
type kind. kind manager_operation -> kind manager_operation_result =
function
| operation -> (
match operation with
| Reveal _ ->
Applied
( Reveal_result {consumed_gas = Z.zero}
: kind successful_manager_operation_result )
| _ ->
Skipped (manager_kind operation) )
let rec mark_skipped :
type kind.
baker:Signature.Public_key_hash.t ->
Level.t ->
kind Kind.manager contents_list ->
kind Kind.manager contents_result_list =
fun ~baker level -> function
| Single (Manager_operation {source; fee; operation}) ->
let source = Contract.implicit_contract source in
Single_result
(Manager_operation_result
{
balance_updates =
Delegate.cleanup_balance_updates
[ (Contract source, Debited fee);
(Fees (baker, level.cycle), Credited fee) ];
operation_result = skipped_operation_result operation;
internal_operation_results = [];
})
| Cons (Manager_operation {source; fee; operation}, rest) ->
let source = Contract.implicit_contract source in
Cons_result
( Manager_operation_result
{
balance_updates =
Delegate.cleanup_balance_updates
[ (Contract source, Debited fee);
(Fees (baker, level.cycle), Credited fee) ];
operation_result = skipped_operation_result operation;
internal_operation_results = [];
},
mark_skipped ~baker level rest )
let rec precheck_manager_contents_list :
type kind.
Alpha_context.t ->
Chain_id.t ->
_ Operation.t ->
kind Kind.manager contents_list ->
context tzresult Lwt.t =
fun ctxt chain_id raw_operation contents_list ->
match contents_list with
| Single (Manager_operation _ as op) ->
precheck_manager_contents ctxt chain_id raw_operation op
| Cons ((Manager_operation _ as op), rest) ->
precheck_manager_contents ctxt chain_id raw_operation op
>>=? fun ctxt ->
precheck_manager_contents_list ctxt chain_id raw_operation rest
let rec apply_manager_contents_list_rec :
type kind.
Alpha_context.t ->
Script_ir_translator.unparsing_mode ->
public_key_hash ->
Chain_id.t ->
kind Kind.manager contents_list ->
([`Success of context | `Failure] * kind Kind.manager contents_result_list)
Lwt.t =
fun ctxt mode baker chain_id contents_list ->
let level = Level.current ctxt in
match contents_list with
| Single (Manager_operation {source; fee; _} as op) ->
let source = Contract.implicit_contract source in
apply_manager_contents ctxt mode chain_id op
>>= fun (ctxt_result, operation_result, internal_operation_results) ->
let result =
Manager_operation_result
{
balance_updates =
Delegate.cleanup_balance_updates
[ (Contract source, Debited fee);
(Fees (baker, level.cycle), Credited fee) ];
operation_result;
internal_operation_results;
}
in
Lwt.return (ctxt_result, Single_result result)
| Cons ((Manager_operation {source; fee; _} as op), rest) -> (
let source = Contract.implicit_contract source in
apply_manager_contents ctxt mode chain_id op
>>= function
| (`Failure, operation_result, internal_operation_results) ->
let result =
Manager_operation_result
{
balance_updates =
Delegate.cleanup_balance_updates
[ (Contract source, Debited fee);
(Fees (baker, level.cycle), Credited fee) ];
operation_result;
internal_operation_results;
}
in
Lwt.return
(`Failure, Cons_result (result, mark_skipped ~baker level rest))
| (`Success ctxt, operation_result, internal_operation_results) ->
let result =
Manager_operation_result
{
balance_updates =
Delegate.cleanup_balance_updates
[ (Contract source, Debited fee);
(Fees (baker, level.cycle), Credited fee) ];
operation_result;
internal_operation_results;
}
in
apply_manager_contents_list_rec ctxt mode baker chain_id rest
>>= fun (ctxt_result, results) ->
Lwt.return (ctxt_result, Cons_result (result, results)) )
let mark_backtracked results =
let rec mark_contents_list :
type kind.
kind Kind.manager contents_result_list ->
kind Kind.manager contents_result_list = function
| Single_result (Manager_operation_result op) ->
Single_result
(Manager_operation_result
{
balance_updates = op.balance_updates;
operation_result =
mark_manager_operation_result op.operation_result;
internal_operation_results =
List.map
mark_internal_operation_results
op.internal_operation_results;
})
| Cons_result (Manager_operation_result op, rest) ->
Cons_result
( Manager_operation_result
{
balance_updates = op.balance_updates;
operation_result =
mark_manager_operation_result op.operation_result;
internal_operation_results =
List.map
mark_internal_operation_results
op.internal_operation_results;
},
mark_contents_list rest )
and mark_internal_operation_results
(Internal_operation_result (kind, result)) =
Internal_operation_result (kind, mark_manager_operation_result result)
and mark_manager_operation_result :
type kind. kind manager_operation_result -> kind manager_operation_result
= function
| (Failed _ | Skipped _ | Backtracked _) as result ->
result
| Applied (Reveal_result _) as result ->
result
| Applied result ->
Backtracked (result, None)
in
mark_contents_list results
let apply_manager_contents_list ctxt mode baker chain_id contents_list =
apply_manager_contents_list_rec ctxt mode baker chain_id contents_list
>>= fun (ctxt_result, results) ->
match ctxt_result with
| `Failure ->
Lwt.return (ctxt (* backtracked *), mark_backtracked results)
| `Success ctxt ->
Big_map.cleanup_temporary ctxt >>= fun ctxt -> Lwt.return (ctxt, results)
let apply_contents_list (type kind) ctxt chain_id mode pred_block baker
(operation : kind operation) (contents_list : kind contents_list) :
(context * kind contents_result_list) tzresult Lwt.t =
match contents_list with
| Single (Endorsement {level}) ->
let block = operation.shell.branch in
fail_unless
(Block_hash.equal block pred_block)
(Wrong_endorsement_predecessor (pred_block, block))
>>=? fun () ->
let current_level = (Level.current ctxt).level in
fail_unless
Raw_level.(succ level = current_level)
Invalid_endorsement_level
>>=? fun () ->
Baking.check_endorsement_rights ctxt chain_id operation
>>=? fun (delegate, slots, used) ->
if used then fail (Duplicate_endorsement delegate)
else
let ctxt = record_endorsement ctxt delegate in
let gap = List.length slots in
Lwt.return
Tez.(Constants.endorsement_security_deposit ctxt *? Int64.of_int gap)
>>=? fun deposit ->
Delegate.freeze_deposit ctxt delegate deposit
>>=? fun ctxt ->
Global.get_block_priority ctxt
>>=? fun block_priority ->
Baking.endorsing_reward ctxt ~block_priority gap
>>=? fun reward ->
Delegate.freeze_rewards ctxt delegate reward
>>=? fun ctxt ->
let level = Level.from_raw ctxt level in
return
( ctxt,
Single_result
(Endorsement_result
{
balance_updates =
Delegate.cleanup_balance_updates
[ ( Contract (Contract.implicit_contract delegate),
Debited deposit );
(Deposits (delegate, level.cycle), Credited deposit);
(Rewards (delegate, level.cycle), Credited reward) ];
delegate;
slots;
}) )
| Single (Seed_nonce_revelation {level; nonce}) ->
let level = Level.from_raw ctxt level in
Nonce.reveal ctxt level nonce
>>=? fun ctxt ->
let seed_nonce_revelation_tip =
Constants.seed_nonce_revelation_tip ctxt
in
add_rewards ctxt seed_nonce_revelation_tip
>>=? fun ctxt ->
return
( ctxt,
Single_result
(Seed_nonce_revelation_result
[ ( Rewards (baker, level.cycle),
Credited seed_nonce_revelation_tip ) ]) )
| Single (Double_endorsement_evidence {op1; op2}) -> (
match (op1.protocol_data.contents, op2.protocol_data.contents) with
| (Single (Endorsement e1), Single (Endorsement e2))
when Raw_level.(e1.level = e2.level)
&& not (Block_hash.equal op1.shell.branch op2.shell.branch) ->
let level = Level.from_raw ctxt e1.level in
let oldest_level = Level.last_allowed_fork_level ctxt in
fail_unless
Level.(level < Level.current ctxt)
(Too_early_double_endorsement_evidence
{level = level.level; current = (Level.current ctxt).level})
>>=? fun () ->
fail_unless
Raw_level.(oldest_level <= level.level)
(Outdated_double_endorsement_evidence
{level = level.level; last = oldest_level})
>>=? fun () ->
Baking.check_endorsement_rights ctxt chain_id op1
>>=? fun (delegate1, _, _) ->
Baking.check_endorsement_rights ctxt chain_id op2
>>=? fun (delegate2, _, _) ->
fail_unless
(Signature.Public_key_hash.equal delegate1 delegate2)
(Inconsistent_double_endorsement_evidence {delegate1; delegate2})
>>=? fun () ->
Delegate.has_frozen_balance ctxt delegate1 level.cycle
>>=? fun valid ->
fail_unless valid Unrequired_double_endorsement_evidence
>>=? fun () ->
Delegate.punish ctxt delegate1 level.cycle
>>=? fun (ctxt, balance) ->
Lwt.return Tez.(balance.deposit +? balance.fees)
>>=? fun burned ->
let reward =
match Tez.(burned /? 2L) with Ok v -> v | Error _ -> Tez.zero
in
add_rewards ctxt reward
>>=? fun ctxt ->
let current_cycle = (Level.current ctxt).cycle in
return
( ctxt,
Single_result
(Double_endorsement_evidence_result
(Delegate.cleanup_balance_updates
[ ( Deposits (delegate1, level.cycle),
Debited balance.deposit );
(Fees (delegate1, level.cycle), Debited balance.fees);
( Rewards (delegate1, level.cycle),
Debited balance.rewards );
(Rewards (baker, current_cycle), Credited reward) ])) )
| (_, _) ->
fail Invalid_double_endorsement_evidence )
| Single (Double_baking_evidence {bh1; bh2}) ->
let hash1 = Block_header.hash bh1 in
let hash2 = Block_header.hash bh2 in
fail_unless
( Compare.Int32.(bh1.shell.level = bh2.shell.level)
&& not (Block_hash.equal hash1 hash2) )
(Invalid_double_baking_evidence
{hash1; level1 = bh1.shell.level; hash2; level2 = bh2.shell.level})
>>=? fun () ->
Lwt.return (Raw_level.of_int32 bh1.shell.level)
>>=? fun raw_level ->
let oldest_level = Level.last_allowed_fork_level ctxt in
fail_unless
Raw_level.(raw_level < (Level.current ctxt).level)
(Too_early_double_baking_evidence
{level = raw_level; current = (Level.current ctxt).level})
>>=? fun () ->
fail_unless
Raw_level.(oldest_level <= raw_level)
(Outdated_double_baking_evidence
{level = raw_level; last = oldest_level})
>>=? fun () ->
let level = Level.from_raw ctxt raw_level in
Roll.baking_rights_owner
ctxt
level
~priority:bh1.protocol_data.contents.priority
>>=? fun delegate1 ->
Baking.check_signature bh1 chain_id delegate1
>>=? fun () ->
Roll.baking_rights_owner
ctxt
level
~priority:bh2.protocol_data.contents.priority
>>=? fun delegate2 ->
Baking.check_signature bh2 chain_id delegate2
>>=? fun () ->
fail_unless
(Signature.Public_key.equal delegate1 delegate2)
(Inconsistent_double_baking_evidence
{
delegate1 = Signature.Public_key.hash delegate1;
delegate2 = Signature.Public_key.hash delegate2;
})
>>=? fun () ->
let delegate = Signature.Public_key.hash delegate1 in
Delegate.has_frozen_balance ctxt delegate level.cycle
>>=? fun valid ->
fail_unless valid Unrequired_double_baking_evidence
>>=? fun () ->
Delegate.punish ctxt delegate level.cycle
>>=? fun (ctxt, balance) ->
Lwt.return Tez.(balance.deposit +? balance.fees)
>>=? fun burned ->
let reward =
match Tez.(burned /? 2L) with Ok v -> v | Error _ -> Tez.zero
in
add_rewards ctxt reward
>>=? fun ctxt ->
let current_cycle = (Level.current ctxt).cycle in
return
( ctxt,
Single_result
(Double_baking_evidence_result
(Delegate.cleanup_balance_updates
[ (Deposits (delegate, level.cycle), Debited balance.deposit);
(Fees (delegate, level.cycle), Debited balance.fees);
(Rewards (delegate, level.cycle), Debited balance.rewards);
(Rewards (baker, current_cycle), Credited reward) ])) )
| Single (Activate_account {id = pkh; activation_code}) -> (
let blinded_pkh =
Blinded_public_key_hash.of_ed25519_pkh activation_code pkh
in
Commitment.get_opt ctxt blinded_pkh
>>=? function
| None ->
fail (Invalid_activation {pkh})
| Some amount ->
Commitment.delete ctxt blinded_pkh
>>=? fun ctxt ->
let contract = Contract.implicit_contract (Signature.Ed25519 pkh) in
Contract.(credit ctxt contract amount)
>>=? fun ctxt ->
return
( ctxt,
Single_result
(Activate_account_result [(Contract contract, Credited amount)])
) )
| Single (Proposals {source; period; proposals}) ->
Roll.delegate_pubkey ctxt source
>>=? fun delegate ->
Operation.check_signature delegate chain_id operation
>>=? fun () ->
let level = Level.current ctxt in
fail_unless
Voting_period.(level.voting_period = period)
(Wrong_voting_period (level.voting_period, period))
>>=? fun () ->
Amendment.record_proposals ctxt source proposals
>>=? fun ctxt -> return (ctxt, Single_result Proposals_result)
| Single (Ballot {source; period; proposal; ballot}) ->
Roll.delegate_pubkey ctxt source
>>=? fun delegate ->
Operation.check_signature delegate chain_id operation
>>=? fun () ->
let level = Level.current ctxt in
fail_unless
Voting_period.(level.voting_period = period)
(Wrong_voting_period (level.voting_period, period))
>>=? fun () ->
Amendment.record_ballot ctxt source proposal ballot
>>=? fun ctxt -> return (ctxt, Single_result Ballot_result)
| Single (Manager_operation _) as op ->
precheck_manager_contents_list ctxt chain_id operation op
>>=? fun ctxt ->
apply_manager_contents_list ctxt mode baker chain_id op
>>= fun (ctxt, result) -> return (ctxt, result)
| Cons (Manager_operation _, _) as op ->
precheck_manager_contents_list ctxt chain_id operation op
>>=? fun ctxt ->
apply_manager_contents_list ctxt mode baker chain_id op
>>= fun (ctxt, result) -> return (ctxt, result)
let apply_operation ctxt chain_id mode pred_block baker hash operation =
let ctxt = Contract.init_origination_nonce ctxt hash in
apply_contents_list
ctxt
chain_id
mode
pred_block
baker
operation
operation.protocol_data.contents
>>=? fun (ctxt, result) ->
let ctxt = Gas.set_unlimited ctxt in
let ctxt = Contract.unset_origination_nonce ctxt in
return (ctxt, {contents = result})
let may_snapshot_roll ctxt =
let level = Alpha_context.Level.current ctxt in
let blocks_per_roll_snapshot = Constants.blocks_per_roll_snapshot ctxt in
if
Compare.Int32.equal
(Int32.rem level.cycle_position blocks_per_roll_snapshot)
(Int32.pred blocks_per_roll_snapshot)
then Alpha_context.Roll.snapshot_rolls ctxt >>=? fun ctxt -> return ctxt
else return ctxt
let may_start_new_cycle ctxt =
Baking.dawn_of_a_new_cycle ctxt
>>=? function
| None ->
return (ctxt, [], [])
| Some last_cycle ->
Seed.cycle_end ctxt last_cycle
>>=? fun (ctxt, unrevealed) ->
Roll.cycle_end ctxt last_cycle
>>=? fun ctxt ->
Delegate.cycle_end ctxt last_cycle unrevealed
>>=? fun (ctxt, update_balances, deactivated) ->
Bootstrap.cycle_end ctxt last_cycle
>>=? fun ctxt -> return (ctxt, update_balances, deactivated)
let begin_full_construction ctxt pred_timestamp protocol_data =
Alpha_context.Global.set_block_priority
ctxt
protocol_data.Block_header.priority
>>=? fun ctxt ->
Baking.check_baking_rights ctxt protocol_data pred_timestamp
>>=? fun (delegate_pk, block_delay) ->
let ctxt = Fitness.increase ctxt in
match Level.pred ctxt (Level.current ctxt) with
| None ->
assert false (* genesis *)
| Some pred_level ->
Baking.endorsement_rights ctxt pred_level
>>=? fun rights ->
let ctxt = init_endorsements ctxt rights in
return (ctxt, protocol_data, delegate_pk, block_delay)
let begin_partial_construction ctxt =
let ctxt = Fitness.increase ctxt in
match Level.pred ctxt (Level.current ctxt) with
| None ->
assert false (* genesis *)
| Some pred_level ->
Baking.endorsement_rights ctxt pred_level
>>=? fun rights ->
let ctxt = init_endorsements ctxt rights in
return ctxt
let begin_application ctxt chain_id block_header pred_timestamp =
Alpha_context.Global.set_block_priority
ctxt
block_header.Block_header.protocol_data.contents.priority
>>=? fun ctxt ->
let current_level = Alpha_context.Level.current ctxt in
Baking.check_proof_of_work_stamp ctxt block_header
>>=? fun () ->
Baking.check_fitness_gap ctxt block_header
>>=? fun () ->
Baking.check_baking_rights
ctxt
block_header.protocol_data.contents
pred_timestamp
>>=? fun (delegate_pk, block_delay) ->
Baking.check_signature block_header chain_id delegate_pk
>>=? fun () ->
let has_commitment =
match block_header.protocol_data.contents.seed_nonce_hash with
| None ->
false
| Some _ ->
true
in
fail_unless
Compare.Bool.(has_commitment = current_level.expected_commitment)
(Invalid_commitment {expected = current_level.expected_commitment})
>>=? fun () ->
let ctxt = Fitness.increase ctxt in
match Level.pred ctxt (Level.current ctxt) with
| None ->
assert false (* genesis *)
| Some pred_level ->
Baking.endorsement_rights ctxt pred_level
>>=? fun rights ->
let ctxt = init_endorsements ctxt rights in
return (ctxt, delegate_pk, block_delay)
let check_minimum_endorsements ctxt protocol_data block_delay
included_endorsements =
let minimum = Baking.minimum_allowed_endorsements ctxt ~block_delay in
let timestamp = Timestamp.current ctxt in
fail_unless
Compare.Int.(included_endorsements >= minimum)
(Not_enough_endorsements_for_priority
{
required = minimum;
priority = protocol_data.Block_header.priority;
endorsements = included_endorsements;
timestamp;
})
let finalize_application ctxt protocol_data delegate ~block_delay =
let included_endorsements = included_endorsements ctxt in
check_minimum_endorsements
ctxt
protocol_data
block_delay
included_endorsements
>>=? fun () ->
let deposit = Constants.block_security_deposit ctxt in
add_deposit ctxt delegate deposit
>>=? fun ctxt ->
Baking.baking_reward
ctxt
~block_priority:protocol_data.priority
~included_endorsements
>>=? fun reward ->
add_rewards ctxt reward
>>=? fun ctxt ->
Signature.Public_key_hash.Map.fold
(fun delegate deposit ctxt ->
ctxt >>=? fun ctxt -> Delegate.freeze_deposit ctxt delegate deposit)
(get_deposits ctxt)
(return ctxt)
>>=? fun ctxt ->
(* end of level (from this point nothing should fail) *)
let fees = Alpha_context.get_fees ctxt in
Delegate.freeze_fees ctxt delegate fees
>>=? fun ctxt ->
let rewards = Alpha_context.get_rewards ctxt in
Delegate.freeze_rewards ctxt delegate rewards
>>=? fun ctxt ->
( match protocol_data.Block_header.seed_nonce_hash with
| None ->
return ctxt
| Some nonce_hash ->
Nonce.record_hash ctxt {nonce_hash; delegate; rewards; fees} )
>>=? fun ctxt ->
(* end of cycle *)
may_snapshot_roll ctxt
>>=? fun ctxt ->
may_start_new_cycle ctxt
>>=? fun (ctxt, balance_updates, deactivated) ->
Amendment.may_start_new_voting_period ctxt
>>=? fun ctxt ->
let cycle = (Level.current ctxt).cycle in
let balance_updates =
Delegate.(
cleanup_balance_updates
( [ (Contract (Contract.implicit_contract delegate), Debited deposit);
(Deposits (delegate, cycle), Credited deposit);
(Rewards (delegate, cycle), Credited reward) ]
@ balance_updates ))
in
let consumed_gas =
Z.sub
(Constants.hard_gas_limit_per_block ctxt)
(Alpha_context.Gas.block_level ctxt)
in
Alpha_context.Vote.get_current_period_kind ctxt
>>=? fun voting_period_kind ->
let receipt =
Apply_results.
{
baker = delegate;
level = Level.current ctxt;
voting_period_kind;
nonce_hash = protocol_data.seed_nonce_hash;
consumed_gas;
deactivated;
balance_updates;
}
in
return (ctxt, receipt)
apply_ml.v
Require Import OCaml.OCaml.
Local Open Scope Z_scope.
Local Open Scope type_scope.
Import ListNotations.
Import Alpha_context.
(* ❌ Structure item `typext` not handled. *)
type_extension
(* ❌ Structure item `typext` not handled. *)
type_extension
(* ❌ Structure item `typext` not handled. *)
type_extension
(* ❌ Structure item `typext` not handled. *)
type_extension
(* ❌ Structure item `typext` not handled. *)
type_extension
(* ❌ Structure item `typext` not handled. *)
type_extension
(* ❌ Structure item `typext` not handled. *)
type_extension
(* ❌ Structure item `typext` not handled. *)
type_extension
(* ❌ Structure item `typext` not handled. *)
type_extension
(* ❌ Structure item `typext` not handled. *)
type_extension
(* ❌ Structure item `typext` not handled. *)
type_extension
(* ❌ Structure item `typext` not handled. *)
type_extension
(* ❌ Structure item `typext` not handled. *)
type_extension
(* ❌ Structure item `typext` not handled. *)
type_extension
(* ❌ Structure item `typext` not handled. *)
type_extension
(* ❌ Structure item `typext` not handled. *)
type_extension
(* ❌ Structure item `typext` not handled. *)
type_extension
(* ❌ Structure item `typext` not handled. *)
type_extension
(* ❌ Structure item `typext` not handled. *)
type_extension
(* ❌ Structure item `typext` not handled. *)
type_extension
(* ❌ Top-level evaluations are considered as an error as sources of side-effects *)
Compute
(* ❌ Sequences of instructions are not handled (operator ";") *)
let _ :=
register_error_kind
(* ❌ Variants not supported *)
variant "operation.wrong_endorsement_predecessor" % string
"Wrong endorsement predecessor" % string
"Trying to include an endorsement in a block that is not the successor of the endorsed one"
% string
(Some
(fun ppf =>
fun function_parameter =>
let '(e, p) := function_parameter in
Format.fprintf ppf
(Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Format
(Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.String_literal
"Wrong predecessor " % string
(Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Alpha
(Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.String_literal
", expected " % string
(Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Alpha
Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.End_of_format))))
"Wrong predecessor %a, expected %a" % string) Block_hash.pp p
Block_hash.pp e))
(obj2 (req None None "expected" % string Block_hash.encoding)
(req None None "provided" % string Block_hash.encoding))
(fun function_parameter =>
match function_parameter with
|
Tezos_protocol_environment_alpha__Environment.Error_monad.Wrong_endorsement_predecessor
e p => Some (e, p)
| _ => None
end)
(fun function_parameter =>
let '(e, p) := function_parameter in
Tezos_protocol_environment_alpha__Environment.Error_monad.Wrong_endorsement_predecessor
e p) in
(* ❌ Sequences of instructions are not handled (operator ";") *)
let _ :=
register_error_kind
(* ❌ Variants not supported *)
variant "operation.wrong_voting_period" % string
"Wrong voting period" % string
"Trying to onclude a proposal or ballot meant for another voting period" %
string
(Some
(fun ppf =>
fun function_parameter =>
let '(e, p) := function_parameter in
Format.fprintf ppf
(Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Format
(Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.String_literal
"Wrong voting period " % string
(Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Alpha
(Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.String_literal
", current is " % string
(Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Alpha
Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.End_of_format))))
"Wrong voting period %a, current is %a" % string)
Voting_period.pp p Voting_period.pp e))
(obj2 (req None None "current" % string Voting_period.encoding)
(req None None "provided" % string Voting_period.encoding))
(fun function_parameter =>
match function_parameter with
|
Tezos_protocol_environment_alpha__Environment.Error_monad.Wrong_voting_period
e p => Some (e, p)
| _ => None
end)
(fun function_parameter =>
let '(e, p) := function_parameter in
Tezos_protocol_environment_alpha__Environment.Error_monad.Wrong_voting_period
e p) in
(* ❌ Sequences of instructions are not handled (operator ";") *)
let _ :=
register_error_kind
(* ❌ Variants not supported *)
variant "operation.duplicate_endorsement" % string
"Duplicate endorsement" % string
"Two endorsements received from same delegate" % string
(Some
(fun ppf =>
fun k =>
Format.fprintf ppf
(Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Format
(Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.String_literal
"Duplicate endorsement from delegate " % string
(Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Alpha
(Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.String_literal
" (possible replay attack)." % string
Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.End_of_format)))
"Duplicate endorsement from delegate %a (possible replay attack)."
% string) Signature.Public_key_hash.pp_short k))
(obj1
(req None None "delegate" % string Signature.Public_key_hash.encoding))
(fun function_parameter =>
match function_parameter with
|
Tezos_protocol_environment_alpha__Environment.Error_monad.Duplicate_endorsement
k => Some k
| _ => None
end)
(fun k =>
Tezos_protocol_environment_alpha__Environment.Error_monad.Duplicate_endorsement
k) in
(* ❌ Sequences of instructions are not handled (operator ";") *)
let _ :=
register_error_kind
(* ❌ Variants not supported *)
variant "operation.invalid_endorsement_level" % string
"Unexpected level in endorsement" % string
"The level of an endorsement is inconsistent with the provided block hash."
% string
(Some
(fun ppf =>
fun function_parameter =>
let 'tt := function_parameter in
Format.fprintf ppf
(Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Format
(Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.String_literal
"Unexpected level in endorsement." % string
Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.End_of_format)
"Unexpected level in endorsement." % string)))
Data_encoding.__unit_value
(fun function_parameter =>
match function_parameter with
|
Tezos_protocol_environment_alpha__Environment.Error_monad.Invalid_endorsement_level
=> Some tt
| _ => None
end)
(fun function_parameter =>
let 'tt := function_parameter in
Tezos_protocol_environment_alpha__Environment.Error_monad.Invalid_endorsement_level)
in
(* ❌ Sequences of instructions are not handled (operator ";") *)
let _ :=
register_error_kind
(* ❌ Variants not supported *)
variant "block.invalid_commitment" % string
"Invalid commitment in block header" % string
"The block header has invalid commitment." % string
(Some
(fun ppf =>
fun expected =>
if expected then
Format.fprintf ppf
(Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Format
(Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.String_literal
"Missing seed's nonce commitment in block header." % string
Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.End_of_format)
"Missing seed's nonce commitment in block header." % string)
else
Format.fprintf ppf
(Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Format
(Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.String_literal
"Unexpected seed's nonce commitment in block header." %
string
Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.End_of_format)
"Unexpected seed's nonce commitment in block header." % string)))
(obj1 (req None None "expected" % string __bool_value))
(fun function_parameter =>
match function_parameter with
|
Tezos_protocol_environment_alpha__Environment.Error_monad.Invalid_commitment
{| Invalid_commitment.expected := expected |} => Some expected
| _ => None
end)
(fun expected =>
Tezos_protocol_environment_alpha__Environment.Error_monad.Invalid_commitment
{| Invalid_commitment.expected := expected |}) in
(* ❌ Sequences of instructions are not handled (operator ";") *)
let _ :=
register_error_kind
(* ❌ Variants not supported *)
variant "internal_operation_replay" % string
"Internal operation replay" % string
"An internal operation was emitted twice by a script" % string
(Some
(fun ppf =>
fun function_parameter =>
let
'Tezos_raw_protocol_alpha.Alpha_context.Internal_operation {|
Tezos_raw_protocol_alpha.Alpha_context.internal_operation.nonce := nonce
|} := function_parameter in
Format.fprintf ppf
(Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Format
(Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.String_literal
"Internal operation " % string
(Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Int
Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Int_d
Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.No_padding
Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.No_precision
(Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.String_literal
" was emitted twice by a script" % string
Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.End_of_format)))
"Internal operation %d was emitted twice by a script" % string)
nonce)) Operation.internal_operation_encoding
(fun function_parameter =>
match function_parameter with
|
Tezos_protocol_environment_alpha__Environment.Error_monad.Internal_operation_replay
op => Some op
| _ => None
end)
(fun op =>
Tezos_protocol_environment_alpha__Environment.Error_monad.Internal_operation_replay
op) in
(* ❌ Sequences of instructions are not handled (operator ";") *)
let _ :=
register_error_kind
(* ❌ Variants not supported *)
variant "block.invalid_double_endorsement_evidence" % string
"Invalid double endorsement evidence" % string
"A double-endorsement evidence is malformed" % string
(Some
(fun ppf =>
fun function_parameter =>
let 'tt := function_parameter in
Format.fprintf ppf
(Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Format
(Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.String_literal
"Malformed double-endorsement evidence" % string
Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.End_of_format)
"Malformed double-endorsement evidence" % string)))
Data_encoding.empty
(fun function_parameter =>
match function_parameter with
|
Tezos_protocol_environment_alpha__Environment.Error_monad.Invalid_double_endorsement_evidence
=> Some tt
| _ => None
end)
(fun function_parameter =>
let 'tt := function_parameter in
Tezos_protocol_environment_alpha__Environment.Error_monad.Invalid_double_endorsement_evidence)
in
(* ❌ Sequences of instructions are not handled (operator ";") *)
let _ :=
register_error_kind
(* ❌ Variants not supported *)
variant "block.inconsistent_double_endorsement_evidence" % string
"Inconsistent double endorsement evidence" % string
"A double-endorsement evidence is inconsistent (two distinct delegates)"
% string
(Some
(fun ppf =>
fun function_parameter =>
let '(delegate1, delegate2) := function_parameter in
Format.fprintf ppf
(Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Format
(Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.String_literal
"Inconsistent double-endorsement evidence (distinct delegate: "
% string
(Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Alpha
(Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.String_literal
" and " % string
(Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Alpha
(Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Char_literal
")" % char
Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.End_of_format)))))
"Inconsistent double-endorsement evidence (distinct delegate: %a and %a)"
% string) Signature.Public_key_hash.pp_short delegate1
Signature.Public_key_hash.pp_short delegate2))
(obj2
(req None None "delegate1" % string Signature.Public_key_hash.encoding)
(req None None "delegate2" % string Signature.Public_key_hash.encoding))
(fun function_parameter =>
match function_parameter with
|
Tezos_protocol_environment_alpha__Environment.Error_monad.Inconsistent_double_endorsement_evidence
{|
Inconsistent_double_endorsement_evidence.delegate1 := delegate1;
Inconsistent_double_endorsement_evidence.delegate2 := delegate2
|} => Some (delegate1, delegate2)
| _ => None
end)
(fun function_parameter =>
let '(delegate1, delegate2) := function_parameter in
Tezos_protocol_environment_alpha__Environment.Error_monad.Inconsistent_double_endorsement_evidence
{| Inconsistent_double_endorsement_evidence.delegate1 := delegate1;
Inconsistent_double_endorsement_evidence.delegate2 := delegate2 |})
in
(* ❌ Sequences of instructions are not handled (operator ";") *)
let _ :=
register_error_kind
(* ❌ Variants not supported *)
variant "block.unrequired_double_endorsement_evidence" % string
"Unrequired double endorsement evidence" % string
"A double-endorsement evidence is unrequired" % string
(Some
(fun ppf =>
fun function_parameter =>
let 'tt := function_parameter in
Format.fprintf ppf
(Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Format
(Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.String_literal
"A valid double-endorsement operation cannot be applied: the associated delegate has previously been denunciated in this cycle."
% string
Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.End_of_format)
"A valid double-endorsement operation cannot be applied: the associated delegate has previously been denunciated in this cycle."
% string))) Data_encoding.empty
(fun function_parameter =>
match function_parameter with
|
Tezos_protocol_environment_alpha__Environment.Error_monad.Unrequired_double_endorsement_evidence
=> Some tt
| _ => None
end)
(fun function_parameter =>
let 'tt := function_parameter in
Tezos_protocol_environment_alpha__Environment.Error_monad.Unrequired_double_endorsement_evidence)
in
(* ❌ Sequences of instructions are not handled (operator ";") *)
let _ :=
register_error_kind
(* ❌ Variants not supported *)
variant "block.too_early_double_endorsement_evidence" % string
"Too early double endorsement evidence" % string
"A double-endorsement evidence is in the future" % string
(Some
(fun ppf =>
fun function_parameter =>
let '(level, current) := function_parameter in
Format.fprintf ppf
(Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Format
(Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.String_literal
"A double-endorsement evidence is in the future (current level: "
% string
(Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Alpha
(Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.String_literal
", endorsement level: " % string
(Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Alpha
(Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Char_literal
")" % char
Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.End_of_format)))))
"A double-endorsement evidence is in the future (current level: %a, endorsement level: %a)"
% string) Raw_level.pp current Raw_level.pp level))
(obj2 (req None None "level" % string Raw_level.encoding)
(req None None "current" % string Raw_level.encoding))
(fun function_parameter =>
match function_parameter with
|
Tezos_protocol_environment_alpha__Environment.Error_monad.Too_early_double_endorsement_evidence
{|
Too_early_double_endorsement_evidence.level := level;
Too_early_double_endorsement_evidence.current := current
|} => Some (level, current)
| _ => None
end)
(fun function_parameter =>
let '(level, current) := function_parameter in
Tezos_protocol_environment_alpha__Environment.Error_monad.Too_early_double_endorsement_evidence
{| Too_early_double_endorsement_evidence.level := level;
Too_early_double_endorsement_evidence.current := current |}) in
(* ❌ Sequences of instructions are not handled (operator ";") *)
let _ :=
register_error_kind
(* ❌ Variants not supported *)
variant "block.outdated_double_endorsement_evidence" % string
"Outdated double endorsement evidence" % string
"A double-endorsement evidence is outdated." % string
(Some
(fun ppf =>
fun function_parameter =>
let '(level, last) := function_parameter in
Format.fprintf ppf
(Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Format
(Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.String_literal
"A double-endorsement evidence is outdated (last acceptable level: "
% string
(Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Alpha
(Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.String_literal
", endorsement level: " % string
(Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Alpha
(Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Char_literal
")" % char
Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.End_of_format)))))
"A double-endorsement evidence is outdated (last acceptable level: %a, endorsement level: %a)"
% string) Raw_level.pp last Raw_level.pp level))
(obj2 (req None None "level" % string Raw_level.encoding)
(req None None "last" % string Raw_level.encoding))
(fun function_parameter =>
match function_parameter with
|
Tezos_protocol_environment_alpha__Environment.Error_monad.Outdated_double_endorsement_evidence
{|
Outdated_double_endorsement_evidence.level := level;
Outdated_double_endorsement_evidence.last := last
|} => Some (level, last)
| _ => None
end)
(fun function_parameter =>
let '(level, last) := function_parameter in
Tezos_protocol_environment_alpha__Environment.Error_monad.Outdated_double_endorsement_evidence
{| Outdated_double_endorsement_evidence.level := level;
Outdated_double_endorsement_evidence.last := last |}) in
(* ❌ Sequences of instructions are not handled (operator ";") *)
let _ :=
register_error_kind
(* ❌ Variants not supported *)
variant "block.invalid_double_baking_evidence" % string
"Invalid double baking evidence" % string
"A double-baking evidence is inconsistent (two distinct level)" % string
(Some
(fun ppf =>
fun function_parameter =>
let '(hash1, level1, hash2, level2) := function_parameter in
Format.fprintf ppf
(Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Format
(Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.String_literal
"Invalid double-baking evidence (hash: " % string
(Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Alpha
(Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.String_literal
" and " % string
(Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Alpha
(Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.String_literal
", levels: " % string
(Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Int32
Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Int_d
Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.No_padding
Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.No_precision
(Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.String_literal
" and " % string
(Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Int32
Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Int_d
Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.No_padding
Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.No_precision
(Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Char_literal
")" % char
Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.End_of_format)))))))))
"Invalid double-baking evidence (hash: %a and %a, levels: %ld and %ld)"
% string) Block_hash.pp hash1 Block_hash.pp hash2 level1
level2))
(obj4 (req None None "hash1" % string Block_hash.encoding)
(req None None "level1" % string __int32_value)
(req None None "hash2" % string Block_hash.encoding)
(req None None "level2" % string __int32_value))
(fun function_parameter =>
match function_parameter with
|
Tezos_protocol_environment_alpha__Environment.Error_monad.Invalid_double_baking_evidence
{|
Invalid_double_baking_evidence.hash1 := hash1;
Invalid_double_baking_evidence.level1 := level1;
Invalid_double_baking_evidence.hash2 := hash2;
Invalid_double_baking_evidence.level2 := level2
|} => Some (hash1, level1, hash2, level2)
| _ => None
end)
(fun function_parameter =>
let '(hash1, level1, hash2, level2) := function_parameter in
Tezos_protocol_environment_alpha__Environment.Error_monad.Invalid_double_baking_evidence
{| Invalid_double_baking_evidence.hash1 := hash1;
Invalid_double_baking_evidence.level1 := level1;
Invalid_double_baking_evidence.hash2 := hash2;
Invalid_double_baking_evidence.level2 := level2 |}) in
(* ❌ Sequences of instructions are not handled (operator ";") *)
let _ :=
register_error_kind
(* ❌ Variants not supported *)
variant "block.inconsistent_double_baking_evidence" % string
"Inconsistent double baking evidence" % string
"A double-baking evidence is inconsistent (two distinct delegates)" %
string
(Some
(fun ppf =>
fun function_parameter =>
let '(delegate1, delegate2) := function_parameter in
Format.fprintf ppf
(Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Format
(Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.String_literal
"Inconsistent double-baking evidence (distinct delegate: " %
string
(Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Alpha
(Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.String_literal
" and " % string
(Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Alpha
(Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Char_literal
")" % char
Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.End_of_format)))))
"Inconsistent double-baking evidence (distinct delegate: %a and %a)"
% string) Signature.Public_key_hash.pp_short delegate1
Signature.Public_key_hash.pp_short delegate2))
(obj2
(req None None "delegate1" % string Signature.Public_key_hash.encoding)
(req None None "delegate2" % string Signature.Public_key_hash.encoding))
(fun function_parameter =>
match function_parameter with
|
Tezos_protocol_environment_alpha__Environment.Error_monad.Inconsistent_double_baking_evidence
{|
Inconsistent_double_baking_evidence.delegate1 := delegate1;
Inconsistent_double_baking_evidence.delegate2 := delegate2
|} => Some (delegate1, delegate2)
| _ => None
end)
(fun function_parameter =>
let '(delegate1, delegate2) := function_parameter in
Tezos_protocol_environment_alpha__Environment.Error_monad.Inconsistent_double_baking_evidence
{| Inconsistent_double_baking_evidence.delegate1 := delegate1;
Inconsistent_double_baking_evidence.delegate2 := delegate2 |}) in
(* ❌ Sequences of instructions are not handled (operator ";") *)
let _ :=
register_error_kind
(* ❌ Variants not supported *)
variant "block.unrequired_double_baking_evidence" % string
"Unrequired double baking evidence" % string
"A double-baking evidence is unrequired" % string
(Some
(fun ppf =>
fun function_parameter =>
let 'tt := function_parameter in
Format.fprintf ppf
(Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Format
(Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.String_literal
"A valid double-baking operation cannot be applied: the associated delegate has previously been denunciated in this cycle."
% string
Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.End_of_format)
"A valid double-baking operation cannot be applied: the associated delegate has previously been denunciated in this cycle."
% string))) Data_encoding.empty
(fun function_parameter =>
match function_parameter with
|
Tezos_protocol_environment_alpha__Environment.Error_monad.Unrequired_double_baking_evidence
=> Some tt
| _ => None
end)
(fun function_parameter =>
let 'tt := function_parameter in
Tezos_protocol_environment_alpha__Environment.Error_monad.Unrequired_double_baking_evidence)
in
(* ❌ Sequences of instructions are not handled (operator ";") *)
let _ :=
register_error_kind
(* ❌ Variants not supported *)
variant "block.too_early_double_baking_evidence" % string
"Too early double baking evidence" % string
"A double-baking evidence is in the future" % string
(Some
(fun ppf =>
fun function_parameter =>
let '(level, current) := function_parameter in
Format.fprintf ppf
(Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Format
(Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.String_literal
"A double-baking evidence is in the future (current level: "
% string
(Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Alpha
(Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.String_literal
", baking level: " % string
(Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Alpha
(Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Char_literal
")" % char
Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.End_of_format)))))
"A double-baking evidence is in the future (current level: %a, baking level: %a)"
% string) Raw_level.pp current Raw_level.pp level))
(obj2 (req None None "level" % string Raw_level.encoding)
(req None None "current" % string Raw_level.encoding))
(fun function_parameter =>
match function_parameter with
|
Tezos_protocol_environment_alpha__Environment.Error_monad.Too_early_double_baking_evidence
{|
Too_early_double_baking_evidence.level := level;
Too_early_double_baking_evidence.current := current
|} => Some (level, current)
| _ => None
end)
(fun function_parameter =>
let '(level, current) := function_parameter in
Tezos_protocol_environment_alpha__Environment.Error_monad.Too_early_double_baking_evidence
{| Too_early_double_baking_evidence.level := level;
Too_early_double_baking_evidence.current := current |}) in
(* ❌ Sequences of instructions are not handled (operator ";") *)
let _ :=
register_error_kind
(* ❌ Variants not supported *)
variant "block.outdated_double_baking_evidence" % string
"Outdated double baking evidence" % string
"A double-baking evidence is outdated." % string
(Some
(fun ppf =>
fun function_parameter =>
let '(level, last) := function_parameter in
Format.fprintf ppf
(Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Format
(Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.String_literal
"A double-baking evidence is outdated (last acceptable level: "
% string
(Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Alpha
(Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.String_literal
", baking level: " % string
(Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Alpha
(Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Char_literal
")" % char
Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.End_of_format)))))
"A double-baking evidence is outdated (last acceptable level: %a, baking level: %a)"
% string) Raw_level.pp last Raw_level.pp level))
(obj2 (req None None "level" % string Raw_level.encoding)
(req None None "last" % string Raw_level.encoding))
(fun function_parameter =>
match function_parameter with
|
Tezos_protocol_environment_alpha__Environment.Error_monad.Outdated_double_baking_evidence
{|
Outdated_double_baking_evidence.level := level;
Outdated_double_baking_evidence.last := last
|} => Some (level, last)
| _ => None
end)
(fun function_parameter =>
let '(level, last) := function_parameter in
Tezos_protocol_environment_alpha__Environment.Error_monad.Outdated_double_baking_evidence
{| Outdated_double_baking_evidence.level := level;
Outdated_double_baking_evidence.last := last |}) in
(* ❌ Sequences of instructions are not handled (operator ";") *)
let _ :=
register_error_kind
(* ❌ Variants not supported *)
variant "operation.invalid_activation" % string
"Invalid activation" % string
"The given key and secret do not correspond to any existing preallocated contract"
% string
(Some
(fun ppf =>
fun pkh =>
Format.fprintf ppf
(Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Format
(Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.String_literal
"Invalid activation. The public key " % string
(Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Alpha
(Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.String_literal
" does not match any commitment." % string
Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.End_of_format)))
"Invalid activation. The public key %a does not match any commitment."
% string) Ed25519.Public_key_hash.pp pkh))
(obj1 (req None None "pkh" % string Ed25519.Public_key_hash.encoding))
(fun function_parameter =>
match function_parameter with
|
Tezos_protocol_environment_alpha__Environment.Error_monad.Invalid_activation
{| Invalid_activation.pkh := pkh |} => Some pkh
| _ => None
end)
(fun pkh =>
Tezos_protocol_environment_alpha__Environment.Error_monad.Invalid_activation
{| Invalid_activation.pkh := pkh |}) in
(* ❌ Sequences of instructions are not handled (operator ";") *)
let _ :=
register_error_kind
(* ❌ Variants not supported *)
variant "block.multiple_revelation" % string
"Multiple revelations were included in a manager operation" % string
"A manager operation should not contain more than one revelation" % string
(Some
(fun ppf =>
fun function_parameter =>
let 'tt := function_parameter in
Format.fprintf ppf
(Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Format
(Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.String_literal
"Multiple revelations were included in a manager operation" %
string
Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.End_of_format)
"Multiple revelations were included in a manager operation" %
string))) Data_encoding.empty
(fun function_parameter =>
match function_parameter with
|
Tezos_protocol_environment_alpha__Environment.Error_monad.Multiple_revelation
=> Some tt
| _ => None
end)
(fun function_parameter =>
let 'tt := function_parameter in
Tezos_protocol_environment_alpha__Environment.Error_monad.Multiple_revelation)
in
(* ❌ Sequences of instructions are not handled (operator ";") *)
let _ :=
register_error_kind
(* ❌ Variants not supported *)
variant "gas_exhausted.init_deserialize" % string
"Not enough gas for initial deserialization of script expresions" % string
"Gas limit was not high enough to deserialize the transaction parameters or origination script code or initial storage, making the operation impossible to parse within the provided gas bounds."
% string None Data_encoding.empty
(fun function_parameter =>
match function_parameter with
|
Tezos_protocol_environment_alpha__Environment.Error_monad.Gas_quota_exceeded_init_deserialize
=> Some tt
| _ => None
end)
(fun function_parameter =>
let 'tt := function_parameter in
Tezos_protocol_environment_alpha__Environment.Error_monad.Gas_quota_exceeded_init_deserialize)
in
register_error_kind
(* ❌ Variants not supported *)
variant "operation.not_enought_endorsements_for_priority" % string
"Not enough endorsements for priority" % string
"The block being validated does not include the required minimum number of endorsements for this priority."
% string
(Some
(fun ppf =>
fun function_parameter =>
let '(required, endorsements, priority, timestamp) :=
function_parameter in
Format.fprintf ppf
(Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Format
(Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.String_literal
"Wrong number of endorsements (" % string
(Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Int
Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Int_i
Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.No_padding
Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.No_precision
(Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.String_literal
") for priority (" % string
(Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Int
Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Int_i
Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.No_padding
Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.No_precision
(Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.String_literal
"), " % string
(Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Int
Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Int_i
Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.No_padding
Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.No_precision
(Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.String_literal
" are expected at " % string
(Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Alpha
Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.End_of_format))))))))
"Wrong number of endorsements (%i) for priority (%i), %i are expected at %a"
% string) endorsements priority required Time.pp_hum timestamp))
(obj4 (req None None "required" % string int31)
(req None None "endorsements" % string int31)
(req None None "priority" % string int31)
(req None None "timestamp" % string Time.encoding))
(fun function_parameter =>
match function_parameter with
|
Tezos_protocol_environment_alpha__Environment.Error_monad.Not_enough_endorsements_for_priority
{|
Not_enough_endorsements_for_priority.required := required;
Not_enough_endorsements_for_priority.priority := priority;
Not_enough_endorsements_for_priority.endorsements := endorsements;
Not_enough_endorsements_for_priority.timestamp := timestamp
|} => Some (required, endorsements, priority, timestamp)
| _ => None
end)
(fun function_parameter =>
let '(required, endorsements, priority, timestamp) := function_parameter
in
Tezos_protocol_environment_alpha__Environment.Error_monad.Not_enough_endorsements_for_priority
{| Not_enough_endorsements_for_priority.required := required;
Not_enough_endorsements_for_priority.priority := priority;
Not_enough_endorsements_for_priority.endorsements := endorsements;
Not_enough_endorsements_for_priority.timestamp := timestamp |}).
Import Apply_results.
Definition apply_manager_operation_content {kind : Set}
(ctxt : Tezos_raw_protocol_alpha.Alpha_context.t)
(mode : Tezos_raw_protocol_alpha.Script_ir_translator.unparsing_mode)
(payer : Tezos_raw_protocol_alpha.Alpha_context.Contract.t)
(source : Tezos_raw_protocol_alpha.Alpha_context.Contract.t)
(chain_id : Tezos_protocol_environment_alpha__Environment.Chain_id.t)
(internal : bool)
(operation : Tezos_raw_protocol_alpha.Alpha_context.manager_operation kind)
: Tezos_protocol_environment_alpha__Environment.Lwt.t
(Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
(Tezos_raw_protocol_alpha.Alpha_context.context *
Tezos_raw_protocol_alpha.Apply_results.successful_manager_operation_result
kind *
list Tezos_raw_protocol_alpha.Alpha_context.packed_internal_operation)) :=
let before_operation := ctxt in
op_gtgteqquestion (Contract.must_exist ctxt source)
(fun function_parameter =>
let 'tt := function_parameter in
op_gtgteqquestion
(Lwt.__return
(Gas.consume ctxt Michelson_v1_gas.Cost_of.manager_operation))
(fun ctxt =>
match operation with
| Tezos_raw_protocol_alpha.Alpha_context.Reveal _ =>
__return
(ctxt,
(Tezos_raw_protocol_alpha.Apply_results.Reveal_result
{|
Tezos_raw_protocol_alpha.Apply_results.successful_manager_operation_result.Reveal_result.consumed_gas :=
Gas.consumed before_operation ctxt |}), [])
|
Tezos_raw_protocol_alpha.Alpha_context.Transaction {|
Tezos_raw_protocol_alpha.Alpha_context.manager_operation.Transaction.amount :=
amount;
Tezos_raw_protocol_alpha.Alpha_context.manager_operation.Transaction.parameters
:= parameters;
Tezos_raw_protocol_alpha.Alpha_context.manager_operation.Transaction.entrypoint
:= entrypoint;
Tezos_raw_protocol_alpha.Alpha_context.manager_operation.Transaction.destination
:= destination
|} =>
op_gtgteqquestion (Contract.spend ctxt source amount)
(fun ctxt =>
op_gtgteqquestion
match Contract.is_implicit destination with
| None => __return (ctxt, [], false)
| Some _ =>
op_gtgteqquestion (Contract.allocated ctxt destination)
(fun function_parameter =>
match function_parameter with
| true => __return (ctxt, [], false)
| false =>
op_gtgteqquestion (Fees.origination_burn ctxt)
(fun function_parameter =>
let '(ctxt, origination_burn) :=
function_parameter in
__return
(ctxt,
(cons
((Tezos_raw_protocol_alpha.Alpha_context.Delegate.Contract
payer),
(Tezos_raw_protocol_alpha.Alpha_context.Delegate.Debited
origination_burn)) []), true))
end)
end
(fun function_parameter =>
let
'(ctxt, maybe_burn_balance_update,
allocated_destination_contract) := function_parameter in
op_gtgteqquestion (Contract.credit ctxt destination amount)
(fun ctxt =>
op_gtgteqquestion (Contract.get_script ctxt destination)
(fun function_parameter =>
let '(ctxt, script) := function_parameter in
match script with
| None =>
op_gtgteqquestion
(op_gtgteqquestion
match entrypoint with
| "default" % string => __return tt
| entrypoint =>
fail
(Tezos_protocol_environment_alpha__Environment.Error_monad.No_such_entrypoint
entrypoint)
end
(fun function_parameter =>
let 'tt := function_parameter in
op_gtgteqquestion
(Script.force_decode ctxt parameters)
(fun function_parameter =>
let '(arg, ctxt) := function_parameter
in
let cost_arg :=
Script.deserialized_cost arg in
op_gtgteqquestion
(Lwt.__return
(Gas.consume ctxt cost_arg))
(fun ctxt =>
match Micheline.root arg with
|
Tezos_protocol_environment_alpha__Environment.Micheline.Prim
_
Tezos_raw_protocol_alpha.Alpha_context.Script.D_Unit
[] _ => __return ctxt
| _ =>
fail
(Tezos_protocol_environment_alpha__Environment.Error_monad.Bad_contract_parameter
destination)
end))))
(fun ctxt =>
let __result_value :=
Tezos_raw_protocol_alpha.Apply_results.Transaction_result
{|
Tezos_raw_protocol_alpha.Apply_results.successful_manager_operation_result.Transaction_result.storage :=
None;
Tezos_raw_protocol_alpha.Apply_results.successful_manager_operation_result.Transaction_result.big_map_diff :=
None;
Tezos_raw_protocol_alpha.Apply_results.successful_manager_operation_result.Transaction_result.balance_updates :=
Delegate.cleanup_balance_updates
(op_at
(cons
((Tezos_raw_protocol_alpha.Alpha_context.Delegate.Contract
source),
(Tezos_raw_protocol_alpha.Alpha_context.Delegate.Debited
amount))
(cons
((Tezos_raw_protocol_alpha.Alpha_context.Delegate.Contract
destination),
(Tezos_raw_protocol_alpha.Alpha_context.Delegate.Credited
amount)) []))
maybe_burn_balance_update);
Tezos_raw_protocol_alpha.Apply_results.successful_manager_operation_result.Transaction_result.originated_contracts :=
[];
Tezos_raw_protocol_alpha.Apply_results.successful_manager_operation_result.Transaction_result.consumed_gas :=
Gas.consumed before_operation ctxt;
Tezos_raw_protocol_alpha.Apply_results.successful_manager_operation_result.Transaction_result.storage_size :=
Z.zero;
Tezos_raw_protocol_alpha.Apply_results.successful_manager_operation_result.Transaction_result.paid_storage_size_diff :=
Z.zero;
Tezos_raw_protocol_alpha.Apply_results.successful_manager_operation_result.Transaction_result.allocated_destination_contract :=
allocated_destination_contract |} in
__return (ctxt, __result_value, []))
| Some script =>
op_gtgteqquestion
(Script.force_decode ctxt parameters)
(fun function_parameter =>
let '(parameter, ctxt) := function_parameter
in
let cost_parameter :=
Script.deserialized_cost parameter in
op_gtgteqquestion
(Lwt.__return
(Gas.consume ctxt cost_parameter))
(fun ctxt =>
let step_constants :=
{|
Tezos_raw_protocol_alpha.Script_interpreter.step_constants.source :=
source;
Tezos_raw_protocol_alpha.Script_interpreter.step_constants.payer :=
payer;
Tezos_raw_protocol_alpha.Script_interpreter.step_constants.self :=
destination;
Tezos_raw_protocol_alpha.Script_interpreter.step_constants.amount :=
amount;
Tezos_raw_protocol_alpha.Script_interpreter.step_constants.chain_id :=
chain_id |} in
op_gtgteqquestion
(Script_interpreter.execute ctxt mode
step_constants script entrypoint
parameter)
(fun function_parameter =>
let '{|
Tezos_raw_protocol_alpha.Script_interpreter.execution_result.ctxt := ctxt;
Tezos_raw_protocol_alpha.Script_interpreter.execution_result.storage
:=
storage;
Tezos_raw_protocol_alpha.Script_interpreter.execution_result.big_map_diff
:=
big_map_diff;
Tezos_raw_protocol_alpha.Script_interpreter.execution_result.operations
:=
operations
|} := function_parameter in
op_gtgteqquestion
(Contract.update_script_storage ctxt
destination storage big_map_diff)
(fun ctxt =>
op_gtgteqquestion
(Fees.record_paid_storage_space
ctxt destination)
(fun function_parameter =>
let
'(ctxt, new_size,
paid_storage_size_diff,
fees) :=
function_parameter in
op_gtgteqquestion
(Contract.originated_from_current_nonce
before_operation ctxt)
(fun originated_contracts =>
let __result_value :=
Tezos_raw_protocol_alpha.Apply_results.Transaction_result
{|
Tezos_raw_protocol_alpha.Apply_results.successful_manager_operation_result.Transaction_result.storage :=
Some storage;
Tezos_raw_protocol_alpha.Apply_results.successful_manager_operation_result.Transaction_result.big_map_diff :=
big_map_diff;
Tezos_raw_protocol_alpha.Apply_results.successful_manager_operation_result.Transaction_result.balance_updates :=
Delegate.cleanup_balance_updates
(cons
((Tezos_raw_protocol_alpha.Alpha_context.Delegate.Contract
payer),
(Tezos_raw_protocol_alpha.Alpha_context.Delegate.Debited
fees))
(cons
((Tezos_raw_protocol_alpha.Alpha_context.Delegate.Contract
source),
(Tezos_raw_protocol_alpha.Alpha_context.Delegate.Debited
amount))
(cons
((Tezos_raw_protocol_alpha.Alpha_context.Delegate.Contract
destination),
(Tezos_raw_protocol_alpha.Alpha_context.Delegate.Credited
amount))
[])));
Tezos_raw_protocol_alpha.Apply_results.successful_manager_operation_result.Transaction_result.originated_contracts :=
originated_contracts;
Tezos_raw_protocol_alpha.Apply_results.successful_manager_operation_result.Transaction_result.consumed_gas :=
Gas.consumed
before_operation
ctxt;
Tezos_raw_protocol_alpha.Apply_results.successful_manager_operation_result.Transaction_result.storage_size :=
new_size;
Tezos_raw_protocol_alpha.Apply_results.successful_manager_operation_result.Transaction_result.paid_storage_size_diff :=
paid_storage_size_diff;
Tezos_raw_protocol_alpha.Apply_results.successful_manager_operation_result.Transaction_result.allocated_destination_contract :=
allocated_destination_contract
|} in
__return
(ctxt, __result_value,
operations)))))))
end))))
|
Tezos_raw_protocol_alpha.Alpha_context.Origination {|
Tezos_raw_protocol_alpha.Alpha_context.manager_operation.Origination.delegate
:= delegate;
Tezos_raw_protocol_alpha.Alpha_context.manager_operation.Origination.script
:= script;
Tezos_raw_protocol_alpha.Alpha_context.manager_operation.Origination.credit
:= credit;
Tezos_raw_protocol_alpha.Alpha_context.manager_operation.Origination.preorigination
:= preorigination
|} =>
op_gtgteqquestion
(Script.force_decode ctxt
(Tezos_raw_protocol_alpha.Alpha_context.Script.t.storage script))
(fun function_parameter =>
let '(unparsed_storage, ctxt) := function_parameter in
op_gtgteqquestion
(Lwt.__return
(Gas.consume ctxt
(Script.deserialized_cost unparsed_storage)))
(fun ctxt =>
op_gtgteqquestion
(Script.force_decode ctxt
(Tezos_raw_protocol_alpha.Alpha_context.Script.t.code
script))
(fun function_parameter =>
let '(unparsed_code, ctxt) := function_parameter in
op_gtgteqquestion
(Lwt.__return
(Gas.consume ctxt
(Script.deserialized_cost unparsed_code)))
(fun ctxt =>
op_gtgteqquestion
(Script_ir_translator.parse_script None ctxt false
script)
(fun function_parameter =>
let
'(Tezos_raw_protocol_alpha.Script_ir_translator.Ex_script
parsed_script, ctxt) := function_parameter
in
op_gtgteqquestion
(Script_ir_translator.collect_big_maps ctxt
(Tezos_raw_protocol_alpha.Script_typed_ir.script.storage_type
parsed_script)
(Tezos_raw_protocol_alpha.Script_typed_ir.script.storage
parsed_script))
(fun function_parameter =>
let '(to_duplicate, ctxt) :=
function_parameter in
let to_update :=
Script_ir_translator.no_big_map_id in
op_gtgteqquestion
(Script_ir_translator.extract_big_map_diff
ctxt
Tezos_raw_protocol_alpha.Script_ir_translator.Optimized
false to_duplicate to_update
(Tezos_raw_protocol_alpha.Script_typed_ir.script.storage_type
parsed_script)
(Tezos_raw_protocol_alpha.Script_typed_ir.script.storage
parsed_script))
(fun function_parameter =>
let '(storage, big_map_diff, ctxt) :=
function_parameter in
op_gtgteqquestion
(Script_ir_translator.unparse_data
ctxt
Tezos_raw_protocol_alpha.Script_ir_translator.Optimized
(Tezos_raw_protocol_alpha.Script_typed_ir.script.storage_type
parsed_script) storage)
(fun function_parameter =>
let '(storage, ctxt) :=
function_parameter in
let storage :=
Script.lazy_expr
(Micheline.strip_locations
storage) in
let script :=
(* ❌ Record substitution not handled *)
record_substitution in
op_gtgteqquestion
(Contract.spend ctxt source credit)
(fun ctxt =>
op_gtgteqquestion
match preorigination with
| Some contract =>
(* ❌ Sequences of instructions are not handled (operator ";") *)
let _ :=
(* ❌ Assert instruction is not handled. *)
assert internal in
__return (ctxt, contract)
| None =>
Contract.fresh_contract_from_current_nonce
ctxt
end
(fun function_parameter =>
let '(ctxt, contract) :=
function_parameter in
op_gtgteqquestion
(Contract.originate ctxt
contract credit
(script, big_map_diff)
delegate)
(fun ctxt =>
op_gtgteqquestion
(Fees.origination_burn
ctxt)
(fun
function_parameter
=>
let
'(ctxt,
origination_burn) :=
function_parameter
in
op_gtgteqquestion
(Fees.record_paid_storage_space
ctxt contract)
(fun
function_parameter
=>
let
'(ctxt, size,
paid_storage_size_diff,
fees) :=
function_parameter
in
let
__result_value :=
Tezos_raw_protocol_alpha.Apply_results.Origination_result
{|
Tezos_raw_protocol_alpha.Apply_results.successful_manager_operation_result.Origination_result.big_map_diff :=
big_map_diff;
Tezos_raw_protocol_alpha.Apply_results.successful_manager_operation_result.Origination_result.balance_updates :=
Delegate.cleanup_balance_updates
(cons
((Tezos_raw_protocol_alpha.Alpha_context.Delegate.Contract
payer),
(Tezos_raw_protocol_alpha.Alpha_context.Delegate.Debited
fees))
(cons
((Tezos_raw_protocol_alpha.Alpha_context.Delegate.Contract
payer),
(Tezos_raw_protocol_alpha.Alpha_context.Delegate.Debited
origination_burn))
(cons
((Tezos_raw_protocol_alpha.Alpha_context.Delegate.Contract
source),
(Tezos_raw_protocol_alpha.Alpha_context.Delegate.Debited
credit))
(cons
((Tezos_raw_protocol_alpha.Alpha_context.Delegate.Contract
contract),
(Tezos_raw_protocol_alpha.Alpha_context.Delegate.Credited
credit))
[]))));
Tezos_raw_protocol_alpha.Apply_results.successful_manager_operation_result.Origination_result.originated_contracts :=
cons
contract
[];
Tezos_raw_protocol_alpha.Apply_results.successful_manager_operation_result.Origination_result.consumed_gas :=
Gas.consumed
before_operation
ctxt;
Tezos_raw_protocol_alpha.Apply_results.successful_manager_operation_result.Origination_result.storage_size :=
size;
Tezos_raw_protocol_alpha.Apply_results.successful_manager_operation_result.Origination_result.paid_storage_size_diff :=
paid_storage_size_diff
|} in
__return
(ctxt,
__result_value,
[]))))))))))))))
| Tezos_raw_protocol_alpha.Alpha_context.Delegation delegate =>
op_gtgteqquestion (Delegate.set ctxt source delegate)
(fun ctxt =>
__return
(ctxt,
(Tezos_raw_protocol_alpha.Apply_results.Delegation_result
{|
Tezos_raw_protocol_alpha.Apply_results.successful_manager_operation_result.Delegation_result.consumed_gas :=
Gas.consumed before_operation ctxt |}), []))
end)).
Definition apply_internal_manager_operations
(ctxt : Tezos_raw_protocol_alpha.Alpha_context.context)
(mode : Tezos_raw_protocol_alpha.Script_ir_translator.unparsing_mode)
(payer : Tezos_raw_protocol_alpha.Alpha_context.Contract.t)
(chain_id : Tezos_protocol_environment_alpha__Environment.Chain_id.t)
(ops : list Tezos_raw_protocol_alpha.Alpha_context.packed_internal_operation)
: Tezos_protocol_environment_alpha__Environment.Lwt.t
(((* `Success *) Tezos_raw_protocol_alpha.Alpha_context.context +
(* `Failure *) unit) *
list
Tezos_raw_protocol_alpha.Apply_results.packed_internal_operation_result) :=
let fix apply
(ctxt : Tezos_raw_protocol_alpha.Alpha_context.context) (applied :
list Tezos_raw_protocol_alpha.Apply_results.packed_internal_operation_result)
(worklist :
list Tezos_raw_protocol_alpha.Alpha_context.packed_internal_operation)
: Tezos_protocol_environment_alpha__Environment.Lwt.t
((* `Success *) Tezos_raw_protocol_alpha.Alpha_context.context *
list
Tezos_raw_protocol_alpha.Apply_results.packed_internal_operation_result) :=
match worklist with
| [] =>
Lwt.__return
((* ❌ Variants not supported *)
variant, (List.rev applied))
|
cons
(Tezos_raw_protocol_alpha.Alpha_context.Internal_operation
({|
Tezos_raw_protocol_alpha.Alpha_context.internal_operation.source := source;
Tezos_raw_protocol_alpha.Alpha_context.internal_operation.operation
:= operation;
Tezos_raw_protocol_alpha.Alpha_context.internal_operation.nonce :=
nonce
|} as op)) rest =>
op_gtgteq
(if internal_nonce_already_recorded ctxt nonce then
fail
(Tezos_protocol_environment_alpha__Environment.Error_monad.Internal_operation_replay
(Tezos_raw_protocol_alpha.Alpha_context.Internal_operation op))
else
let ctxt := record_internal_nonce ctxt nonce in
apply_manager_operation_content ctxt mode payer source chain_id true
operation)
(fun function_parameter =>
match function_parameter with
|
Tezos_protocol_environment_alpha__Environment.Pervasives.Error
errors =>
let __result_value :=
Tezos_raw_protocol_alpha.Apply_results.Internal_operation_result
op
(Tezos_raw_protocol_alpha.Apply_results.Failed
(manager_kind
(Tezos_raw_protocol_alpha.Alpha_context.internal_operation.operation
op)) errors) in
let skipped :=
List.rev_map
(fun function_parameter =>
let
'Tezos_raw_protocol_alpha.Alpha_context.Internal_operation
op := function_parameter in
Tezos_raw_protocol_alpha.Apply_results.Internal_operation_result
op
(Tezos_raw_protocol_alpha.Apply_results.Skipped
(manager_kind
(Tezos_raw_protocol_alpha.Alpha_context.internal_operation.operation
op)))) rest in
Lwt.__return
((* ❌ Variants not supported *)
variant, (List.rev (op_at skipped (cons __result_value applied))))
|
Tezos_protocol_environment_alpha__Environment.Pervasives.Ok
(ctxt, __result_value, emitted) =>
apply ctxt
(cons
(Tezos_raw_protocol_alpha.Apply_results.Internal_operation_result
op
(Tezos_raw_protocol_alpha.Apply_results.Applied __result_value))
applied) (op_at rest emitted)
end)
end in
apply ctxt [] ops.
Definition precheck_manager_contents {A B : Set}
(ctxt : Tezos_raw_protocol_alpha__Alpha_context.context)
(chain_id : Tezos_protocol_environment_alpha__Environment.Chain_id.t)
(raw_operation : Tezos_raw_protocol_alpha__Alpha_context.operation A)
(op :
Tezos_raw_protocol_alpha.Alpha_context.contents
(Tezos_raw_protocol_alpha.Alpha_context.Kind.manager B))
: Tezos_protocol_environment_alpha__Environment.Lwt.t
(Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
Tezos_raw_protocol_alpha.Alpha_context.context) :=
let
'Tezos_raw_protocol_alpha.Alpha_context.Manager_operation {|
Tezos_raw_protocol_alpha.Alpha_context.contents.Manager_operation.source :=
source;
Tezos_raw_protocol_alpha.Alpha_context.contents.Manager_operation.fee :=
fee;
Tezos_raw_protocol_alpha.Alpha_context.contents.Manager_operation.counter
:= counter;
Tezos_raw_protocol_alpha.Alpha_context.contents.Manager_operation.operation
:= operation;
Tezos_raw_protocol_alpha.Alpha_context.contents.Manager_operation.gas_limit
:= gas_limit;
Tezos_raw_protocol_alpha.Alpha_context.contents.Manager_operation.storage_limit
:= storage_limit
|} := op in
op_gtgteqquestion (Lwt.__return (Gas.check_limit ctxt gas_limit))
(fun function_parameter =>
let 'tt := function_parameter in
let ctxt := Gas.set_limit ctxt gas_limit in
op_gtgteqquestion
(Lwt.__return (Fees.check_storage_limit ctxt storage_limit))
(fun function_parameter =>
let 'tt := function_parameter in
op_gtgteqquestion
(Contract.must_be_allocated ctxt (Contract.implicit_contract source))
(fun function_parameter =>
let 'tt := function_parameter in
op_gtgteqquestion
(Contract.check_counter_increment ctxt source counter)
(fun function_parameter =>
let 'tt := function_parameter in
op_gtgteqquestion
match operation with
| Tezos_raw_protocol_alpha.Alpha_context.Reveal pk =>
Contract.reveal_manager_key ctxt source pk
|
Tezos_raw_protocol_alpha.Alpha_context.Transaction {|
Tezos_raw_protocol_alpha.Alpha_context.manager_operation.Transaction.parameters
:= parameters
|} =>
op_gtgteqquestion
(op_atat Lwt.__return
(op_atat
(record_trace
Tezos_protocol_environment_alpha__Environment.Error_monad.Gas_quota_exceeded_init_deserialize)
(Gas.check_enough ctxt
(Script.minimal_deserialize_cost parameters))))
(fun function_parameter =>
let 'tt := function_parameter in
op_gtgtpipequestion
(op_atat
(trace
Tezos_protocol_environment_alpha__Environment.Error_monad.Gas_quota_exceeded_init_deserialize)
(Script.force_decode ctxt parameters))
(fun function_parameter =>
let '(_arg, ctxt) := function_parameter in
ctxt))
|
Tezos_raw_protocol_alpha.Alpha_context.Origination {|
Tezos_raw_protocol_alpha.Alpha_context.manager_operation.Origination.script :=
script
|} =>
op_gtgteqquestion
(op_atat Lwt.__return
(op_atat
(record_trace
Tezos_protocol_environment_alpha__Environment.Error_monad.Gas_quota_exceeded_init_deserialize)
(op_gtgtquestion
(Gas.consume ctxt
(Script.minimal_deserialize_cost
(Tezos_raw_protocol_alpha.Alpha_context.Script.t.code
script)))
(fun ctxt =>
Gas.check_enough ctxt
(Script.minimal_deserialize_cost
(Tezos_raw_protocol_alpha.Alpha_context.Script.t.storage
script))))))
(fun function_parameter =>
let 'tt := function_parameter in
op_gtgteqquestion
(op_atat
(trace
Tezos_protocol_environment_alpha__Environment.Error_monad.Gas_quota_exceeded_init_deserialize)
(Script.force_decode ctxt
(Tezos_raw_protocol_alpha.Alpha_context.Script.t.code
script)))
(fun function_parameter =>
let '(_code, ctxt) := function_parameter in
op_gtgtpipequestion
(op_atat
(trace
Tezos_protocol_environment_alpha__Environment.Error_monad.Gas_quota_exceeded_init_deserialize)
(Script.force_decode ctxt
(Tezos_raw_protocol_alpha.Alpha_context.Script.t.storage
script)))
(fun function_parameter =>
let '(_storage, ctxt) := function_parameter in
ctxt)))
| _ => __return ctxt
end
(fun ctxt =>
op_gtgteqquestion (Contract.get_manager_key ctxt source)
(fun public_key =>
op_gtgteqquestion
(Operation.check_signature public_key chain_id
raw_operation)
(fun function_parameter =>
let 'tt := function_parameter in
op_gtgteqquestion
(Contract.increment_counter ctxt source)
(fun ctxt =>
op_gtgteqquestion
(Contract.spend ctxt
(Contract.implicit_contract source) fee)
(fun ctxt =>
op_gtgteqquestion (add_fees ctxt fee)
(fun ctxt => __return ctxt)))))))))).
Definition apply_manager_contents {A : Set}
(ctxt : Tezos_raw_protocol_alpha__Alpha_context.context)
(mode : Tezos_raw_protocol_alpha.Script_ir_translator.unparsing_mode)
(chain_id : Tezos_protocol_environment_alpha__Environment.Chain_id.t)
(op :
Tezos_raw_protocol_alpha.Alpha_context.contents
(Tezos_raw_protocol_alpha.Alpha_context.Kind.manager A))
: Tezos_protocol_environment_alpha__Environment.Lwt.t
(((* `Failure *) unit +
(* `Success *) Tezos_raw_protocol_alpha.Alpha_context.context) *
Tezos_raw_protocol_alpha.Apply_results.manager_operation_result A *
list
Tezos_raw_protocol_alpha.Apply_results.packed_internal_operation_result) :=
let
'Tezos_raw_protocol_alpha.Alpha_context.Manager_operation {|
Tezos_raw_protocol_alpha.Alpha_context.contents.Manager_operation.source :=
source;
Tezos_raw_protocol_alpha.Alpha_context.contents.Manager_operation.operation
:= operation;
Tezos_raw_protocol_alpha.Alpha_context.contents.Manager_operation.gas_limit
:= gas_limit;
Tezos_raw_protocol_alpha.Alpha_context.contents.Manager_operation.storage_limit
:= storage_limit
|} := op in
let ctxt := Gas.set_limit ctxt gas_limit in
let ctxt := Fees.start_counting_storage_fees ctxt in
let source := Contract.implicit_contract source in
op_gtgteq
(apply_manager_operation_content ctxt mode source source chain_id false
operation)
(fun function_parameter =>
match function_parameter with
|
Tezos_protocol_environment_alpha__Environment.Pervasives.Ok
(ctxt, operation_results, internal_operations) =>
op_gtgteq
(apply_internal_manager_operations ctxt mode source chain_id
internal_operations)
(fun function_parameter =>
match function_parameter with
| (Success ctxt, internal_operations_results) =>
op_gtgteq (Fees.burn_storage_fees ctxt storage_limit source)
(fun function_parameter =>
match function_parameter with
|
Tezos_protocol_environment_alpha__Environment.Pervasives.Ok
ctxt =>
Lwt.__return
((* ❌ Variants not supported *)
variant,
(Tezos_raw_protocol_alpha.Apply_results.Applied
operation_results), internal_operations_results)
|
Tezos_protocol_environment_alpha__Environment.Pervasives.Error
errors =>
Lwt.__return
((* ❌ Variants not supported *)
variant,
(Tezos_raw_protocol_alpha.Apply_results.Backtracked
operation_results (Some errors)),
internal_operations_results)
end)
| (Failure, internal_operations_results) =>
Lwt.__return
((* ❌ Variants not supported *)
variant,
(Tezos_raw_protocol_alpha.Apply_results.Applied
operation_results), internal_operations_results)
end)
| Tezos_protocol_environment_alpha__Environment.Pervasives.Error errors =>
Lwt.__return
((* ❌ Variants not supported *)
variant,
(Tezos_raw_protocol_alpha.Apply_results.Failed
(manager_kind operation) errors), [])
end).
Definition skipped_operation_result {kind : Set}
(operation : Tezos_raw_protocol_alpha.Alpha_context.manager_operation kind)
: Tezos_raw_protocol_alpha.Apply_results.manager_operation_result kind :=
match operation with
| Tezos_raw_protocol_alpha.Alpha_context.Reveal _ =>
Tezos_raw_protocol_alpha.Apply_results.Applied
(Tezos_raw_protocol_alpha.Apply_results.Reveal_result
{|
Tezos_raw_protocol_alpha.Apply_results.successful_manager_operation_result.Reveal_result.consumed_gas :=
Z.zero |})
| _ => Tezos_raw_protocol_alpha.Apply_results.Skipped (manager_kind operation)
end.
Fixpoint mark_skipped {kind : Set}
(baker :
Tezos_protocol_environment_alpha__Environment.Signature.Public_key_hash.t)
(level : Tezos_raw_protocol_alpha.Alpha_context.Level.t)
(function_parameter :
Tezos_raw_protocol_alpha.Alpha_context.contents_list
(Tezos_raw_protocol_alpha.Alpha_context.Kind.manager kind))
: Tezos_raw_protocol_alpha.Apply_results.contents_result_list
(Tezos_raw_protocol_alpha.Alpha_context.Kind.manager kind) :=
match function_parameter with
|
Tezos_raw_protocol_alpha.Alpha_context.Single
(Tezos_raw_protocol_alpha.Alpha_context.Manager_operation {|
Tezos_raw_protocol_alpha.Alpha_context.contents.Manager_operation.source :=
source;
Tezos_raw_protocol_alpha.Alpha_context.contents.Manager_operation.fee
:= fee;
Tezos_raw_protocol_alpha.Alpha_context.contents.Manager_operation.operation
:= operation
|}) =>
let source := Contract.implicit_contract source in
Tezos_raw_protocol_alpha.Apply_results.Single_result
(Tezos_raw_protocol_alpha.Apply_results.Manager_operation_result
{|
Tezos_raw_protocol_alpha.Apply_results.contents_result.Manager_operation_result.balance_updates :=
Delegate.cleanup_balance_updates
(cons
((Tezos_raw_protocol_alpha.Alpha_context.Delegate.Contract
source),
(Tezos_raw_protocol_alpha.Alpha_context.Delegate.Debited fee))
(cons
((Tezos_raw_protocol_alpha.Alpha_context.Delegate.Fees baker
(Tezos_raw_protocol_alpha.Alpha_context.Level.t.cycle level)),
(Tezos_raw_protocol_alpha.Alpha_context.Delegate.Credited
fee)) []));
Tezos_raw_protocol_alpha.Apply_results.contents_result.Manager_operation_result.operation_result :=
skipped_operation_result operation;
Tezos_raw_protocol_alpha.Apply_results.contents_result.Manager_operation_result.internal_operation_results :=
[] |})
|
Tezos_raw_protocol_alpha.Alpha_context.Cons
(Tezos_raw_protocol_alpha.Alpha_context.Manager_operation {|
Tezos_raw_protocol_alpha.Alpha_context.contents.Manager_operation.source :=
source;
Tezos_raw_protocol_alpha.Alpha_context.contents.Manager_operation.fee
:= fee;
Tezos_raw_protocol_alpha.Alpha_context.contents.Manager_operation.operation
:= operation
|}) rest =>
let source := Contract.implicit_contract source in
Tezos_raw_protocol_alpha.Apply_results.Cons_result
(Tezos_raw_protocol_alpha.Apply_results.Manager_operation_result
{|
Tezos_raw_protocol_alpha.Apply_results.contents_result.Manager_operation_result.balance_updates :=
Delegate.cleanup_balance_updates
(cons
((Tezos_raw_protocol_alpha.Alpha_context.Delegate.Contract
source),
(Tezos_raw_protocol_alpha.Alpha_context.Delegate.Debited fee))
(cons
((Tezos_raw_protocol_alpha.Alpha_context.Delegate.Fees baker
(Tezos_raw_protocol_alpha.Alpha_context.Level.t.cycle level)),
(Tezos_raw_protocol_alpha.Alpha_context.Delegate.Credited
fee)) []));
Tezos_raw_protocol_alpha.Apply_results.contents_result.Manager_operation_result.operation_result :=
skipped_operation_result operation;
Tezos_raw_protocol_alpha.Apply_results.contents_result.Manager_operation_result.internal_operation_results :=
[] |}) (mark_skipped baker level rest)
end.
Fixpoint precheck_manager_contents_list {A kind : Set}
(ctxt : Tezos_raw_protocol_alpha.Alpha_context.t)
(chain_id : Tezos_protocol_environment_alpha__Environment.Chain_id.t)
(raw_operation : Tezos_raw_protocol_alpha.Alpha_context.Operation.t A)
(contents_list :
Tezos_raw_protocol_alpha.Alpha_context.contents_list
(Tezos_raw_protocol_alpha.Alpha_context.Kind.manager kind))
: Tezos_protocol_environment_alpha__Environment.Lwt.t
(Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
Tezos_raw_protocol_alpha.Alpha_context.context) :=
match contents_list with
|
Tezos_raw_protocol_alpha.Alpha_context.Single
((Tezos_raw_protocol_alpha.Alpha_context.Manager_operation _) as op) =>
precheck_manager_contents ctxt chain_id raw_operation op
|
Tezos_raw_protocol_alpha.Alpha_context.Cons
((Tezos_raw_protocol_alpha.Alpha_context.Manager_operation _) as op) rest
=>
op_gtgteqquestion (precheck_manager_contents ctxt chain_id raw_operation op)
(fun ctxt =>
precheck_manager_contents_list ctxt chain_id raw_operation rest)
end.
Fixpoint apply_manager_contents_list_rec {kind : Set}
(ctxt : Tezos_raw_protocol_alpha.Alpha_context.t)
(mode : Tezos_raw_protocol_alpha.Script_ir_translator.unparsing_mode)
(baker : Tezos_raw_protocol_alpha.Alpha_context.public_key_hash)
(chain_id : Tezos_protocol_environment_alpha__Environment.Chain_id.t)
(contents_list :
Tezos_raw_protocol_alpha.Alpha_context.contents_list
(Tezos_raw_protocol_alpha.Alpha_context.Kind.manager kind))
: Tezos_protocol_environment_alpha__Environment.Lwt.t
(((* `Failure *) unit +
(* `Success *) Tezos_raw_protocol_alpha.Alpha_context.context) *
Tezos_raw_protocol_alpha.Apply_results.contents_result_list
(Tezos_raw_protocol_alpha.Alpha_context.Kind.manager kind)) :=
let level := Level.current ctxt in
match contents_list with
|
Tezos_raw_protocol_alpha.Alpha_context.Single
((Tezos_raw_protocol_alpha.Alpha_context.Manager_operation {|
Tezos_raw_protocol_alpha.Alpha_context.contents.Manager_operation.source :=
source;
Tezos_raw_protocol_alpha.Alpha_context.contents.Manager_operation.fee
:= fee
|}) as op) =>
let source := Contract.implicit_contract source in
op_gtgteq (apply_manager_contents ctxt mode chain_id op)
(fun function_parameter =>
let '(ctxt_result, operation_result, internal_operation_results) :=
function_parameter in
let __result_value :=
Tezos_raw_protocol_alpha.Apply_results.Manager_operation_result
{|
Tezos_raw_protocol_alpha.Apply_results.contents_result.Manager_operation_result.balance_updates :=
Delegate.cleanup_balance_updates
(cons
((Tezos_raw_protocol_alpha.Alpha_context.Delegate.Contract
source),
(Tezos_raw_protocol_alpha.Alpha_context.Delegate.Debited
fee))
(cons
((Tezos_raw_protocol_alpha.Alpha_context.Delegate.Fees
baker
(Tezos_raw_protocol_alpha.Alpha_context.Level.t.cycle
level)),
(Tezos_raw_protocol_alpha.Alpha_context.Delegate.Credited
fee)) []));
Tezos_raw_protocol_alpha.Apply_results.contents_result.Manager_operation_result.operation_result :=
operation_result;
Tezos_raw_protocol_alpha.Apply_results.contents_result.Manager_operation_result.internal_operation_results :=
internal_operation_results |} in
Lwt.__return
(ctxt_result,
(Tezos_raw_protocol_alpha.Apply_results.Single_result __result_value)))
|
Tezos_raw_protocol_alpha.Alpha_context.Cons
((Tezos_raw_protocol_alpha.Alpha_context.Manager_operation {|
Tezos_raw_protocol_alpha.Alpha_context.contents.Manager_operation.source :=
source;
Tezos_raw_protocol_alpha.Alpha_context.contents.Manager_operation.fee
:= fee
|}) as op) rest =>
let source := Contract.implicit_contract source in
op_gtgteq (apply_manager_contents ctxt mode chain_id op)
(fun function_parameter =>
match function_parameter with
| (Failure, operation_result, internal_operation_results) =>
let __result_value :=
Tezos_raw_protocol_alpha.Apply_results.Manager_operation_result
{|
Tezos_raw_protocol_alpha.Apply_results.contents_result.Manager_operation_result.balance_updates :=
Delegate.cleanup_balance_updates
(cons
((Tezos_raw_protocol_alpha.Alpha_context.Delegate.Contract
source),
(Tezos_raw_protocol_alpha.Alpha_context.Delegate.Debited
fee))
(cons
((Tezos_raw_protocol_alpha.Alpha_context.Delegate.Fees
baker
(Tezos_raw_protocol_alpha.Alpha_context.Level.t.cycle
level)),
(Tezos_raw_protocol_alpha.Alpha_context.Delegate.Credited
fee)) []));
Tezos_raw_protocol_alpha.Apply_results.contents_result.Manager_operation_result.operation_result :=
operation_result;
Tezos_raw_protocol_alpha.Apply_results.contents_result.Manager_operation_result.internal_operation_results :=
internal_operation_results |} in
Lwt.__return
((* ❌ Variants not supported *)
variant,
(Tezos_raw_protocol_alpha.Apply_results.Cons_result __result_value
(mark_skipped baker level rest)))
| (Success ctxt, operation_result, internal_operation_results) =>
let __result_value :=
Tezos_raw_protocol_alpha.Apply_results.Manager_operation_result
{|
Tezos_raw_protocol_alpha.Apply_results.contents_result.Manager_operation_result.balance_updates :=
Delegate.cleanup_balance_updates
(cons
((Tezos_raw_protocol_alpha.Alpha_context.Delegate.Contract
source),
(Tezos_raw_protocol_alpha.Alpha_context.Delegate.Debited
fee))
(cons
((Tezos_raw_protocol_alpha.Alpha_context.Delegate.Fees
baker
(Tezos_raw_protocol_alpha.Alpha_context.Level.t.cycle
level)),
(Tezos_raw_protocol_alpha.Alpha_context.Delegate.Credited
fee)) []));
Tezos_raw_protocol_alpha.Apply_results.contents_result.Manager_operation_result.operation_result :=
operation_result;
Tezos_raw_protocol_alpha.Apply_results.contents_result.Manager_operation_result.internal_operation_results :=
internal_operation_results |} in
op_gtgteq
(apply_manager_contents_list_rec ctxt mode baker chain_id rest)
(fun function_parameter =>
let '(ctxt_result, results) := function_parameter in
Lwt.__return
(ctxt_result,
(Tezos_raw_protocol_alpha.Apply_results.Cons_result
__result_value results)))
end)
end.
Definition mark_backtracked {A : Set}
(results :
Tezos_raw_protocol_alpha.Apply_results.contents_result_list
(Tezos_raw_protocol_alpha.Alpha_context.Kind.manager A))
: Tezos_raw_protocol_alpha.Apply_results.contents_result_list
(Tezos_raw_protocol_alpha.Alpha_context.Kind.manager A) :=
let fix mark_contents_list {kind : Set}
(function_parameter :
Tezos_raw_protocol_alpha.Apply_results.contents_result_list
(Tezos_raw_protocol_alpha.Alpha_context.Kind.manager kind))
: Tezos_raw_protocol_alpha.Apply_results.contents_result_list
(Tezos_raw_protocol_alpha.Alpha_context.Kind.manager kind) :=
match function_parameter with
|
Tezos_raw_protocol_alpha.Apply_results.Single_result
(Tezos_raw_protocol_alpha.Apply_results.Manager_operation_result op) =>
Tezos_raw_protocol_alpha.Apply_results.Single_result
(Tezos_raw_protocol_alpha.Apply_results.Manager_operation_result
{|
Tezos_raw_protocol_alpha.Apply_results.contents_result.Manager_operation_result.balance_updates :=
Tezos_raw_protocol_alpha.Apply_results.contents_result.Manager_operation_result.balance_updates
op;
Tezos_raw_protocol_alpha.Apply_results.contents_result.Manager_operation_result.operation_result :=
mark_manager_operation_result
(Tezos_raw_protocol_alpha.Apply_results.contents_result.Manager_operation_result.operation_result
op);
Tezos_raw_protocol_alpha.Apply_results.contents_result.Manager_operation_result.internal_operation_results :=
List.map mark_internal_operation_results
(Tezos_raw_protocol_alpha.Apply_results.contents_result.Manager_operation_result.internal_operation_results
op) |})
|
Tezos_raw_protocol_alpha.Apply_results.Cons_result
(Tezos_raw_protocol_alpha.Apply_results.Manager_operation_result op)
rest =>
Tezos_raw_protocol_alpha.Apply_results.Cons_result
(Tezos_raw_protocol_alpha.Apply_results.Manager_operation_result
{|
Tezos_raw_protocol_alpha.Apply_results.contents_result.Manager_operation_result.balance_updates :=
Tezos_raw_protocol_alpha.Apply_results.contents_result.Manager_operation_result.balance_updates
op;
Tezos_raw_protocol_alpha.Apply_results.contents_result.Manager_operation_result.operation_result :=
mark_manager_operation_result
(Tezos_raw_protocol_alpha.Apply_results.contents_result.Manager_operation_result.operation_result
op);
Tezos_raw_protocol_alpha.Apply_results.contents_result.Manager_operation_result.internal_operation_results :=
List.map mark_internal_operation_results
(Tezos_raw_protocol_alpha.Apply_results.contents_result.Manager_operation_result.internal_operation_results
op) |}) (mark_contents_list rest)
end
with mark_internal_operation_results
(function_parameter :
Tezos_raw_protocol_alpha.Apply_results.packed_internal_operation_result)
: Tezos_raw_protocol_alpha.Apply_results.packed_internal_operation_result :=
let
'Tezos_raw_protocol_alpha.Apply_results.Internal_operation_result kind
__result_value := function_parameter in
Tezos_raw_protocol_alpha.Apply_results.Internal_operation_result kind
(mark_manager_operation_result __result_value)
with mark_manager_operation_result {kind : Set}
(function_parameter :
Tezos_raw_protocol_alpha.Apply_results.manager_operation_result kind)
: Tezos_raw_protocol_alpha.Apply_results.manager_operation_result kind :=
match function_parameter with
|
(Tezos_raw_protocol_alpha.Apply_results.Failed _ _ |
Tezos_raw_protocol_alpha.Apply_results.Skipped _ |
Tezos_raw_protocol_alpha.Apply_results.Backtracked _ _) as
__result_value => __result_value
|
(Tezos_raw_protocol_alpha.Apply_results.Applied
(Tezos_raw_protocol_alpha.Apply_results.Reveal_result _)) as
__result_value => __result_value
| Tezos_raw_protocol_alpha.Apply_results.Applied __result_value =>
Tezos_raw_protocol_alpha.Apply_results.Backtracked __result_value None
end in
mark_contents_list results.
Definition apply_manager_contents_list {A : Set}
(ctxt : Tezos_raw_protocol_alpha.Alpha_context.t)
(mode : Tezos_raw_protocol_alpha.Script_ir_translator.unparsing_mode)
(baker : Tezos_raw_protocol_alpha.Alpha_context.public_key_hash)
(chain_id : Tezos_protocol_environment_alpha__Environment.Chain_id.t)
(contents_list :
Tezos_raw_protocol_alpha.Alpha_context.contents_list
(Tezos_raw_protocol_alpha.Alpha_context.Kind.manager A))
: Tezos_protocol_environment_alpha__Environment.Lwt.t
(Tezos_raw_protocol_alpha.Alpha_context.t *
Tezos_raw_protocol_alpha.Apply_results.contents_result_list
(Tezos_raw_protocol_alpha.Alpha_context.Kind.manager A)) :=
op_gtgteq
(apply_manager_contents_list_rec ctxt mode baker chain_id contents_list)
(fun function_parameter =>
let '(ctxt_result, results) := function_parameter in
match ctxt_result with
| Failure => Lwt.__return (ctxt, (mark_backtracked results))
| Success ctxt =>
op_gtgteq (Big_map.cleanup_temporary ctxt)
(fun ctxt => Lwt.__return (ctxt, results))
end).
Definition apply_contents_list {A : Set}
(ctxt : Tezos_raw_protocol_alpha__Alpha_context.context)
(chain_id : Tezos_protocol_environment_alpha__Environment.Chain_id.t)
(mode : Tezos_raw_protocol_alpha.Script_ir_translator.unparsing_mode)
(pred_block : Tezos_protocol_environment_alpha__Environment.Block_hash.t)
(baker :
Tezos_protocol_environment_alpha__Environment.Signature.Public_key_hash.t)
(operation : Tezos_raw_protocol_alpha.Alpha_context.operation A)
(contents_list : Tezos_raw_protocol_alpha.Alpha_context.contents_list A)
: Tezos_protocol_environment_alpha__Environment.Lwt.t
(Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
(Tezos_raw_protocol_alpha.Alpha_context.context *
Tezos_raw_protocol_alpha.Apply_results.contents_result_list A)) :=
match contents_list with
|
Tezos_raw_protocol_alpha.Alpha_context.Single
(Tezos_raw_protocol_alpha.Alpha_context.Endorsement {|
Tezos_raw_protocol_alpha.Alpha_context.contents.Endorsement.level := level
|}) =>
let block :=
Tezos_protocol_environment_alpha__Environment.Operation.shell_header.branch
(Tezos_raw_protocol_alpha.Alpha_context.operation.shell operation) in
op_gtgteqquestion
(fail_unless (Block_hash.equal block pred_block)
(Tezos_protocol_environment_alpha__Environment.Error_monad.Wrong_endorsement_predecessor
pred_block block))
(fun function_parameter =>
let 'tt := function_parameter in
let current_level :=
Tezos_raw_protocol_alpha.Alpha_context.Level.t.level
(Level.current ctxt) in
op_gtgteqquestion
(fail_unless (op_eq (succ level) current_level)
Tezos_protocol_environment_alpha__Environment.Error_monad.Invalid_endorsement_level)
(fun function_parameter =>
let 'tt := function_parameter in
op_gtgteqquestion
(Baking.check_endorsement_rights ctxt chain_id operation)
(fun function_parameter =>
let '(delegate, slots, used) := function_parameter in
if used then
fail
(Tezos_protocol_environment_alpha__Environment.Error_monad.Duplicate_endorsement
delegate)
else
let ctxt := record_endorsement ctxt delegate in
let gap := List.length slots in
op_gtgteqquestion
(Lwt.__return
(op_starquestion
(Constants.endorsement_security_deposit ctxt)
(Int64.of_int gap)))
(fun deposit =>
op_gtgteqquestion
(Delegate.freeze_deposit ctxt delegate deposit)
(fun ctxt =>
op_gtgteqquestion (Global.get_block_priority ctxt)
(fun block_priority =>
op_gtgteqquestion
(Baking.endorsing_reward ctxt block_priority gap)
(fun reward =>
op_gtgteqquestion
(Delegate.freeze_rewards ctxt delegate
reward)
(fun ctxt =>
let level :=
Level.from_raw ctxt None level in
__return
(ctxt,
(Tezos_raw_protocol_alpha.Apply_results.Single_result
(Tezos_raw_protocol_alpha.Apply_results.Endorsement_result
{|
Tezos_raw_protocol_alpha.Apply_results.contents_result.Endorsement_result.balance_updates :=
Delegate.cleanup_balance_updates
(cons
((Tezos_raw_protocol_alpha.Alpha_context.Delegate.Contract
(Contract.implicit_contract
delegate)),
(Tezos_raw_protocol_alpha.Alpha_context.Delegate.Debited
deposit))
(cons
((Tezos_raw_protocol_alpha.Alpha_context.Delegate.Deposits
delegate
(Tezos_raw_protocol_alpha.Alpha_context.Level.t.cycle
level)),
(Tezos_raw_protocol_alpha.Alpha_context.Delegate.Credited
deposit))
(cons
((Tezos_raw_protocol_alpha.Alpha_context.Delegate.Rewards
delegate
(Tezos_raw_protocol_alpha.Alpha_context.Level.t.cycle
level)),
(Tezos_raw_protocol_alpha.Alpha_context.Delegate.Credited
reward)) [])));
Tezos_raw_protocol_alpha.Apply_results.contents_result.Endorsement_result.delegate :=
delegate;
Tezos_raw_protocol_alpha.Apply_results.contents_result.Endorsement_result.slots :=
slots |})))))))))))
|
Tezos_raw_protocol_alpha.Alpha_context.Single
(Tezos_raw_protocol_alpha.Alpha_context.Seed_nonce_revelation {|
Tezos_raw_protocol_alpha.Alpha_context.contents.Seed_nonce_revelation.level :=
level;
Tezos_raw_protocol_alpha.Alpha_context.contents.Seed_nonce_revelation.nonce
:= nonce
|}) =>
let level := Level.from_raw ctxt None level in
op_gtgteqquestion (Nonce.reveal ctxt level nonce)
(fun ctxt =>
let seed_nonce_revelation_tip :=
Constants.seed_nonce_revelation_tip ctxt in
op_gtgteqquestion (add_rewards ctxt seed_nonce_revelation_tip)
(fun ctxt =>
__return
(ctxt,
(Tezos_raw_protocol_alpha.Apply_results.Single_result
(Tezos_raw_protocol_alpha.Apply_results.Seed_nonce_revelation_result
(cons
((Tezos_raw_protocol_alpha.Alpha_context.Delegate.Rewards
baker
(Tezos_raw_protocol_alpha.Alpha_context.Level.t.cycle
level)),
(Tezos_raw_protocol_alpha.Alpha_context.Delegate.Credited
seed_nonce_revelation_tip)) []))))))
|
Tezos_raw_protocol_alpha.Alpha_context.Single
(Tezos_raw_protocol_alpha.Alpha_context.Double_endorsement_evidence {|
Tezos_raw_protocol_alpha.Alpha_context.contents.Double_endorsement_evidence.op1
:= op1;
Tezos_raw_protocol_alpha.Alpha_context.contents.Double_endorsement_evidence.op2
:= op2
|}) =>
match
((Tezos_raw_protocol_alpha.Alpha_context.protocol_data.contents
(Tezos_raw_protocol_alpha.Alpha_context.operation.protocol_data op1)),
(Tezos_raw_protocol_alpha.Alpha_context.protocol_data.contents
(Tezos_raw_protocol_alpha.Alpha_context.operation.protocol_data op2)))
with
|
(Tezos_raw_protocol_alpha.Alpha_context.Single
(Tezos_raw_protocol_alpha.Alpha_context.Endorsement e1),
Tezos_raw_protocol_alpha.Alpha_context.Single
(Tezos_raw_protocol_alpha.Alpha_context.Endorsement e2)) =>
let level :=
Level.from_raw ctxt None
(Tezos_raw_protocol_alpha.Alpha_context.contents.Endorsement.level e1)
in
let oldest_level := Level.last_allowed_fork_level ctxt in
op_gtgteqquestion
(fail_unless (op_lt level (Level.current ctxt))
(Tezos_protocol_environment_alpha__Environment.Error_monad.Too_early_double_endorsement_evidence
{|
Too_early_double_endorsement_evidence.level :=
Tezos_raw_protocol_alpha.Alpha_context.Level.t.level level;
Too_early_double_endorsement_evidence.current :=
Tezos_raw_protocol_alpha.Alpha_context.Level.t.level
(Level.current ctxt) |}))
(fun function_parameter =>
let 'tt := function_parameter in
op_gtgteqquestion
(fail_unless
(op_lteq oldest_level
(Tezos_raw_protocol_alpha.Alpha_context.Level.t.level level))
(Tezos_protocol_environment_alpha__Environment.Error_monad.Outdated_double_endorsement_evidence
{|
Outdated_double_endorsement_evidence.level :=
Tezos_raw_protocol_alpha.Alpha_context.Level.t.level level;
Outdated_double_endorsement_evidence.last := oldest_level |}))
(fun function_parameter =>
let 'tt := function_parameter in
op_gtgteqquestion
(Baking.check_endorsement_rights ctxt chain_id op1)
(fun function_parameter =>
let '(delegate1, _, _) := function_parameter in
op_gtgteqquestion
(Baking.check_endorsement_rights ctxt chain_id op2)
(fun function_parameter =>
let '(delegate2, _, _) := function_parameter in
op_gtgteqquestion
(fail_unless
(Signature.Public_key_hash.equal delegate1 delegate2)
(Tezos_protocol_environment_alpha__Environment.Error_monad.Inconsistent_double_endorsement_evidence
{|
Inconsistent_double_endorsement_evidence.delegate1 :=
delegate1;
Inconsistent_double_endorsement_evidence.delegate2 :=
delegate2 |}))
(fun function_parameter =>
let 'tt := function_parameter in
op_gtgteqquestion
(Delegate.has_frozen_balance ctxt delegate1
(Tezos_raw_protocol_alpha.Alpha_context.Level.t.cycle
level))
(fun valid =>
op_gtgteqquestion
(fail_unless valid
Tezos_protocol_environment_alpha__Environment.Error_monad.Unrequired_double_endorsement_evidence)
(fun function_parameter =>
let 'tt := function_parameter in
op_gtgteqquestion
(Delegate.punish ctxt delegate1
(Tezos_raw_protocol_alpha.Alpha_context.Level.t.cycle
level))
(fun function_parameter =>
let '(ctxt, balance) := function_parameter
in
op_gtgteqquestion
(Lwt.__return
(op_plusquestion
(Tezos_raw_protocol_alpha.Alpha_context.Delegate.frozen_balance.deposit
balance)
(Tezos_raw_protocol_alpha.Alpha_context.Delegate.frozen_balance.fees
balance)))
(fun burned =>
let reward :=
match
op_divquestion burned
(* ❌ Constant of type int64 is converted to int *)
2 with
|
Tezos_protocol_environment_alpha__Environment.Pervasives.Ok
v => v
|
Tezos_protocol_environment_alpha__Environment.Pervasives.Error
_ => Tez.zero
end in
op_gtgteqquestion
(add_rewards ctxt reward)
(fun ctxt =>
let current_cycle :=
Tezos_raw_protocol_alpha.Alpha_context.Level.t.cycle
(Level.current ctxt) in
__return
(ctxt,
(Tezos_raw_protocol_alpha.Apply_results.Single_result
(Tezos_raw_protocol_alpha.Apply_results.Double_endorsement_evidence_result
(Delegate.cleanup_balance_updates
(cons
((Tezos_raw_protocol_alpha.Alpha_context.Delegate.Deposits
delegate1
(Tezos_raw_protocol_alpha.Alpha_context.Level.t.cycle
level)),
(Tezos_raw_protocol_alpha.Alpha_context.Delegate.Debited
(Tezos_raw_protocol_alpha.Alpha_context.Delegate.frozen_balance.deposit
balance)))
(cons
((Tezos_raw_protocol_alpha.Alpha_context.Delegate.Fees
delegate1
(Tezos_raw_protocol_alpha.Alpha_context.Level.t.cycle
level)),
(Tezos_raw_protocol_alpha.Alpha_context.Delegate.Debited
(Tezos_raw_protocol_alpha.Alpha_context.Delegate.frozen_balance.fees
balance)))
(cons
((Tezos_raw_protocol_alpha.Alpha_context.Delegate.Rewards
delegate1
(Tezos_raw_protocol_alpha.Alpha_context.Level.t.cycle
level)),
(Tezos_raw_protocol_alpha.Alpha_context.Delegate.Debited
(Tezos_raw_protocol_alpha.Alpha_context.Delegate.frozen_balance.rewards
balance)))
(cons
((Tezos_raw_protocol_alpha.Alpha_context.Delegate.Rewards
baker
current_cycle),
(Tezos_raw_protocol_alpha.Alpha_context.Delegate.Credited
reward)) []))))))))))))))))))
| (_, _) =>
fail
Tezos_protocol_environment_alpha__Environment.Error_monad.Invalid_double_endorsement_evidence
end
|
Tezos_raw_protocol_alpha.Alpha_context.Single
(Tezos_raw_protocol_alpha.Alpha_context.Double_baking_evidence {|
Tezos_raw_protocol_alpha.Alpha_context.contents.Double_baking_evidence.bh1 :=
bh1;
Tezos_raw_protocol_alpha.Alpha_context.contents.Double_baking_evidence.bh2
:= bh2
|}) =>
let hash1 := Block_header.__hash_value bh1 in
let hash2 := Block_header.__hash_value bh2 in
op_gtgteqquestion
(fail_unless
(op_andand
(op_eq
(Tezos_protocol_environment_alpha__Environment.Block_header.shell_header.level
(Tezos_raw_protocol_alpha.Alpha_context.Block_header.t.shell bh1))
(Tezos_protocol_environment_alpha__Environment.Block_header.shell_header.level
(Tezos_raw_protocol_alpha.Alpha_context.Block_header.t.shell bh2)))
(not (Block_hash.equal hash1 hash2)))
(Tezos_protocol_environment_alpha__Environment.Error_monad.Invalid_double_baking_evidence
{| Invalid_double_baking_evidence.hash1 := hash1;
Invalid_double_baking_evidence.level1 :=
Tezos_protocol_environment_alpha__Environment.Block_header.shell_header.level
(Tezos_raw_protocol_alpha.Alpha_context.Block_header.t.shell bh1);
Invalid_double_baking_evidence.hash2 := hash2;
Invalid_double_baking_evidence.level2 :=
Tezos_protocol_environment_alpha__Environment.Block_header.shell_header.level
(Tezos_raw_protocol_alpha.Alpha_context.Block_header.t.shell bh2)
|}))
(fun function_parameter =>
let 'tt := function_parameter in
op_gtgteqquestion
(Lwt.__return
(Raw_level.of_int32
(Tezos_protocol_environment_alpha__Environment.Block_header.shell_header.level
(Tezos_raw_protocol_alpha.Alpha_context.Block_header.t.shell bh1))))
(fun raw_level =>
let oldest_level := Level.last_allowed_fork_level ctxt in
op_gtgteqquestion
(fail_unless
(op_lt raw_level
(Tezos_raw_protocol_alpha.Alpha_context.Level.t.level
(Level.current ctxt)))
(Tezos_protocol_environment_alpha__Environment.Error_monad.Too_early_double_baking_evidence
{| Too_early_double_baking_evidence.level := raw_level;
Too_early_double_baking_evidence.current :=
Tezos_raw_protocol_alpha.Alpha_context.Level.t.level
(Level.current ctxt) |}))
(fun function_parameter =>
let 'tt := function_parameter in
op_gtgteqquestion
(fail_unless (op_lteq oldest_level raw_level)
(Tezos_protocol_environment_alpha__Environment.Error_monad.Outdated_double_baking_evidence
{| Outdated_double_baking_evidence.level := raw_level;
Outdated_double_baking_evidence.last := oldest_level |}))
(fun function_parameter =>
let 'tt := function_parameter in
let level := Level.from_raw ctxt None raw_level in
op_gtgteqquestion
(Roll.baking_rights_owner ctxt level
(Tezos_raw_protocol_alpha.Alpha_context.Block_header.contents.priority
(Tezos_raw_protocol_alpha.Alpha_context.Block_header.protocol_data.contents
(Tezos_raw_protocol_alpha.Alpha_context.Block_header.t.protocol_data
bh1))))
(fun delegate1 =>
op_gtgteqquestion
(Baking.check_signature bh1 chain_id delegate1)
(fun function_parameter =>
let 'tt := function_parameter in
op_gtgteqquestion
(Roll.baking_rights_owner ctxt level
(Tezos_raw_protocol_alpha.Alpha_context.Block_header.contents.priority
(Tezos_raw_protocol_alpha.Alpha_context.Block_header.protocol_data.contents
(Tezos_raw_protocol_alpha.Alpha_context.Block_header.t.protocol_data
bh2))))
(fun delegate2 =>
op_gtgteqquestion
(Baking.check_signature bh2 chain_id delegate2)
(fun function_parameter =>
let 'tt := function_parameter in
op_gtgteqquestion
(fail_unless
(Signature.Public_key.equal delegate1
delegate2)
(Tezos_protocol_environment_alpha__Environment.Error_monad.Inconsistent_double_baking_evidence
{|
Inconsistent_double_baking_evidence.delegate1 :=
Signature.Public_key.__hash_value
delegate1;
Inconsistent_double_baking_evidence.delegate2 :=
Signature.Public_key.__hash_value
delegate2 |}))
(fun function_parameter =>
let 'tt := function_parameter in
let delegate :=
Signature.Public_key.__hash_value
delegate1 in
op_gtgteqquestion
(Delegate.has_frozen_balance ctxt
delegate
(Tezos_raw_protocol_alpha.Alpha_context.Level.t.cycle
level))
(fun valid =>
op_gtgteqquestion
(fail_unless valid
Tezos_protocol_environment_alpha__Environment.Error_monad.Unrequired_double_baking_evidence)
(fun function_parameter =>
let 'tt := function_parameter in
op_gtgteqquestion
(Delegate.punish ctxt delegate
(Tezos_raw_protocol_alpha.Alpha_context.Level.t.cycle
level))
(fun function_parameter =>
let '(ctxt, balance) :=
function_parameter in
op_gtgteqquestion
(Lwt.__return
(op_plusquestion
(Tezos_raw_protocol_alpha.Alpha_context.Delegate.frozen_balance.deposit
balance)
(Tezos_raw_protocol_alpha.Alpha_context.Delegate.frozen_balance.fees
balance)))
(fun burned =>
let reward :=
match
op_divquestion
burned
(* ❌ Constant of type int64 is converted to int *)
2 with
|
Tezos_protocol_environment_alpha__Environment.Pervasives.Ok
v => v
|
Tezos_protocol_environment_alpha__Environment.Pervasives.Error
_ => Tez.zero
end in
op_gtgteqquestion
(add_rewards ctxt
reward)
(fun ctxt =>
let current_cycle :=
Tezos_raw_protocol_alpha.Alpha_context.Level.t.cycle
(Level.current
ctxt) in
__return
(ctxt,
(Tezos_raw_protocol_alpha.Apply_results.Single_result
(Tezos_raw_protocol_alpha.Apply_results.Double_baking_evidence_result
(Delegate.cleanup_balance_updates
(cons
((Tezos_raw_protocol_alpha.Alpha_context.Delegate.Deposits
delegate
(Tezos_raw_protocol_alpha.Alpha_context.Level.t.cycle
level)),
(Tezos_raw_protocol_alpha.Alpha_context.Delegate.Debited
(Tezos_raw_protocol_alpha.Alpha_context.Delegate.frozen_balance.deposit
balance)))
(cons
((Tezos_raw_protocol_alpha.Alpha_context.Delegate.Fees
delegate
(Tezos_raw_protocol_alpha.Alpha_context.Level.t.cycle
level)),
(Tezos_raw_protocol_alpha.Alpha_context.Delegate.Debited
(Tezos_raw_protocol_alpha.Alpha_context.Delegate.frozen_balance.fees
balance)))
(cons
((Tezos_raw_protocol_alpha.Alpha_context.Delegate.Rewards
delegate
(Tezos_raw_protocol_alpha.Alpha_context.Level.t.cycle
level)),
(Tezos_raw_protocol_alpha.Alpha_context.Delegate.Debited
(Tezos_raw_protocol_alpha.Alpha_context.Delegate.frozen_balance.rewards
balance)))
(cons
((Tezos_raw_protocol_alpha.Alpha_context.Delegate.Rewards
baker
current_cycle),
(Tezos_raw_protocol_alpha.Alpha_context.Delegate.Credited
reward))
[]))))))))))))))))))))))
|
Tezos_raw_protocol_alpha.Alpha_context.Single
(Tezos_raw_protocol_alpha.Alpha_context.Activate_account {|
Tezos_raw_protocol_alpha.Alpha_context.contents.Activate_account.id := pkh;
Tezos_raw_protocol_alpha.Alpha_context.contents.Activate_account.activation_code
:= activation_code
|}) =>
let blinded_pkh :=
Blinded_public_key_hash.of_ed25519_pkh activation_code pkh in
op_gtgteqquestion (Commitment.get_opt ctxt blinded_pkh)
(fun function_parameter =>
match function_parameter with
| None =>
fail
(Tezos_protocol_environment_alpha__Environment.Error_monad.Invalid_activation
{| Invalid_activation.pkh := pkh |})
| Some amount =>
op_gtgteqquestion (Commitment.delete ctxt blinded_pkh)
(fun ctxt =>
let contract :=
Contract.implicit_contract
(Tezos_protocol_environment_alpha__Environment.Signature.Ed25519
pkh) in
op_gtgteqquestion (credit ctxt contract amount)
(fun ctxt =>
__return
(ctxt,
(Tezos_raw_protocol_alpha.Apply_results.Single_result
(Tezos_raw_protocol_alpha.Apply_results.Activate_account_result
(cons
((Tezos_raw_protocol_alpha.Alpha_context.Delegate.Contract
contract),
(Tezos_raw_protocol_alpha.Alpha_context.Delegate.Credited
amount)) []))))))
end)
|
Tezos_raw_protocol_alpha.Alpha_context.Single
(Tezos_raw_protocol_alpha.Alpha_context.Proposals {|
Tezos_raw_protocol_alpha.Alpha_context.contents.Proposals.source := source;
Tezos_raw_protocol_alpha.Alpha_context.contents.Proposals.period :=
period;
Tezos_raw_protocol_alpha.Alpha_context.contents.Proposals.proposals :=
proposals
|}) =>
op_gtgteqquestion (Roll.delegate_pubkey ctxt source)
(fun delegate =>
op_gtgteqquestion
(Operation.check_signature delegate chain_id operation)
(fun function_parameter =>
let 'tt := function_parameter in
let level := Level.current ctxt in
op_gtgteqquestion
(fail_unless
(op_eq
(Tezos_raw_protocol_alpha.Alpha_context.Level.t.voting_period
level) period)
(Tezos_protocol_environment_alpha__Environment.Error_monad.Wrong_voting_period
(Tezos_raw_protocol_alpha.Alpha_context.Level.t.voting_period
level) period))
(fun function_parameter =>
let 'tt := function_parameter in
op_gtgteqquestion
(Amendment.record_proposals ctxt source proposals)
(fun ctxt =>
__return
(ctxt,
(Tezos_raw_protocol_alpha.Apply_results.Single_result
Tezos_raw_protocol_alpha.Apply_results.Proposals_result))))))
|
Tezos_raw_protocol_alpha.Alpha_context.Single
(Tezos_raw_protocol_alpha.Alpha_context.Ballot {|
Tezos_raw_protocol_alpha.Alpha_context.contents.Ballot.source := source;
Tezos_raw_protocol_alpha.Alpha_context.contents.Ballot.period :=
period;
Tezos_raw_protocol_alpha.Alpha_context.contents.Ballot.proposal :=
proposal;
Tezos_raw_protocol_alpha.Alpha_context.contents.Ballot.ballot :=
ballot
|}) =>
op_gtgteqquestion (Roll.delegate_pubkey ctxt source)
(fun delegate =>
op_gtgteqquestion
(Operation.check_signature delegate chain_id operation)
(fun function_parameter =>
let 'tt := function_parameter in
let level := Level.current ctxt in
op_gtgteqquestion
(fail_unless
(op_eq
(Tezos_raw_protocol_alpha.Alpha_context.Level.t.voting_period
level) period)
(Tezos_protocol_environment_alpha__Environment.Error_monad.Wrong_voting_period
(Tezos_raw_protocol_alpha.Alpha_context.Level.t.voting_period
level) period))
(fun function_parameter =>
let 'tt := function_parameter in
op_gtgteqquestion
(Amendment.record_ballot ctxt source proposal ballot)
(fun ctxt =>
__return
(ctxt,
(Tezos_raw_protocol_alpha.Apply_results.Single_result
Tezos_raw_protocol_alpha.Apply_results.Ballot_result))))))
|
(Tezos_raw_protocol_alpha.Alpha_context.Single
(Tezos_raw_protocol_alpha.Alpha_context.Manager_operation _)) as op =>
op_gtgteqquestion
(precheck_manager_contents_list ctxt chain_id operation op)
(fun ctxt =>
op_gtgteq (apply_manager_contents_list ctxt mode baker chain_id op)
(fun function_parameter =>
let '(ctxt, __result_value) := function_parameter in
__return (ctxt, __result_value)))
|
(Tezos_raw_protocol_alpha.Alpha_context.Cons
(Tezos_raw_protocol_alpha.Alpha_context.Manager_operation _) _) as op =>
op_gtgteqquestion
(precheck_manager_contents_list ctxt chain_id operation op)
(fun ctxt =>
op_gtgteq (apply_manager_contents_list ctxt mode baker chain_id op)
(fun function_parameter =>
let '(ctxt, __result_value) := function_parameter in
__return (ctxt, __result_value)))
end.
Definition apply_operation {A : Set}
(ctxt : Tezos_raw_protocol_alpha__Alpha_context.context)
(chain_id : Tezos_protocol_environment_alpha__Environment.Chain_id.t)
(mode : Tezos_raw_protocol_alpha.Script_ir_translator.unparsing_mode)
(pred_block : Tezos_protocol_environment_alpha__Environment.Block_hash.t)
(baker :
Tezos_protocol_environment_alpha__Environment.Signature.Public_key_hash.t)
(__hash_value : Tezos_protocol_environment_alpha__Environment.Operation_hash.t)
(operation : Tezos_raw_protocol_alpha.Alpha_context.operation A)
: Tezos_protocol_environment_alpha__Environment.Lwt.t
(Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
(Tezos_raw_protocol_alpha__Alpha_context.context *
Tezos_raw_protocol_alpha.Apply_results.operation_metadata A)) :=
let ctxt := Contract.init_origination_nonce ctxt __hash_value in
op_gtgteqquestion
(apply_contents_list ctxt chain_id mode pred_block baker operation
(Tezos_raw_protocol_alpha.Alpha_context.protocol_data.contents
(Tezos_raw_protocol_alpha.Alpha_context.operation.protocol_data
operation)))
(fun function_parameter =>
let '(ctxt, __result_value) := function_parameter in
let ctxt := Gas.set_unlimited ctxt in
let ctxt := Contract.unset_origination_nonce ctxt in
__return
(ctxt,
{|
Tezos_raw_protocol_alpha.Apply_results.operation_metadata.contents :=
__result_value |})).
Definition may_snapshot_roll
(ctxt : Tezos_raw_protocol_alpha__Alpha_context.context)
: Tezos_protocol_environment_alpha__Environment.Lwt.t
(Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
Tezos_raw_protocol_alpha__Alpha_context.context) :=
let level := Alpha_context.Level.current ctxt in
let blocks_per_roll_snapshot := Constants.blocks_per_roll_snapshot ctxt in
if
Compare.Int32.equal
(Int32.rem
(Tezos_raw_protocol_alpha.Alpha_context.Level.t.cycle_position level)
blocks_per_roll_snapshot) (Int32.pred blocks_per_roll_snapshot) then
op_gtgteqquestion (Alpha_context.Roll.snapshot_rolls ctxt)
(fun ctxt => __return ctxt)
else
__return ctxt.
Definition may_start_new_cycle
(ctxt : Tezos_raw_protocol_alpha.Alpha_context.context)
: Tezos_protocol_environment_alpha__Environment.Lwt.t
(Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
(Tezos_raw_protocol_alpha.Alpha_context.context *
Tezos_raw_protocol_alpha.Alpha_context.Delegate.balance_updates *
list
Tezos_protocol_environment_alpha__Environment.Signature.Public_key_hash.t)) :=
op_gtgteqquestion (Baking.dawn_of_a_new_cycle ctxt)
(fun function_parameter =>
match function_parameter with
| None => __return (ctxt, [], [])
| Some last_cycle =>
op_gtgteqquestion (Seed.cycle_end ctxt last_cycle)
(fun function_parameter =>
let '(ctxt, unrevealed) := function_parameter in
op_gtgteqquestion (Roll.cycle_end ctxt last_cycle)
(fun ctxt =>
op_gtgteqquestion
(Delegate.cycle_end ctxt last_cycle unrevealed)
(fun function_parameter =>
let '(ctxt, update_balances, deactivated) :=
function_parameter in
op_gtgteqquestion (Bootstrap.cycle_end ctxt last_cycle)
(fun ctxt => __return (ctxt, update_balances, deactivated)))))
end).
Definition begin_full_construction
(ctxt : Tezos_raw_protocol_alpha__Alpha_context.context)
(pred_timestamp : Tezos_protocol_environment_alpha__Environment.Time.t)
(protocol_data : Tezos_raw_protocol_alpha.Alpha_context.Block_header.contents)
: Tezos_protocol_environment_alpha__Environment.Lwt.t
(Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
(Tezos_raw_protocol_alpha.Alpha_context.context *
Tezos_raw_protocol_alpha.Alpha_context.Block_header.contents *
Tezos_raw_protocol_alpha.Alpha_context.public_key *
Tezos_raw_protocol_alpha.Alpha_context.Period.t)) :=
op_gtgteqquestion
(Alpha_context.Global.set_block_priority ctxt
(Tezos_raw_protocol_alpha.Alpha_context.Block_header.contents.priority
protocol_data))
(fun ctxt =>
op_gtgteqquestion
(Baking.check_baking_rights ctxt protocol_data pred_timestamp)
(fun function_parameter =>
let '(delegate_pk, block_delay) := function_parameter in
let ctxt := Fitness.increase None ctxt in
match Level.pred ctxt (Level.current ctxt) with
| None =>
(* ❌ Assert instruction is not handled. *)
assert false
| Some pred_level =>
op_gtgteqquestion (Baking.endorsement_rights ctxt pred_level)
(fun rights =>
let ctxt := init_endorsements ctxt rights in
__return (ctxt, protocol_data, delegate_pk, block_delay))
end)).
Definition begin_partial_construction
(ctxt : Tezos_raw_protocol_alpha__Alpha_context.context)
: Tezos_protocol_environment_alpha__Environment.Lwt.t
(Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
Tezos_raw_protocol_alpha.Alpha_context.context) :=
let ctxt := Fitness.increase None ctxt in
match Level.pred ctxt (Level.current ctxt) with
| None =>
(* ❌ Assert instruction is not handled. *)
assert false
| Some pred_level =>
op_gtgteqquestion (Baking.endorsement_rights ctxt pred_level)
(fun rights =>
let ctxt := init_endorsements ctxt rights in
__return ctxt)
end.
Definition begin_application
(ctxt : Tezos_raw_protocol_alpha__Alpha_context.context)
(chain_id : Tezos_protocol_environment_alpha__Environment.Chain_id.t)
(block_header : Tezos_raw_protocol_alpha.Alpha_context.Block_header.t)
(pred_timestamp : Tezos_protocol_environment_alpha__Environment.Time.t)
: Tezos_protocol_environment_alpha__Environment.Lwt.t
(Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
(Tezos_raw_protocol_alpha.Alpha_context.context *
Tezos_raw_protocol_alpha.Alpha_context.public_key *
Tezos_raw_protocol_alpha.Alpha_context.Period.t)) :=
op_gtgteqquestion
(Alpha_context.Global.set_block_priority ctxt
(Tezos_raw_protocol_alpha.Alpha_context.Block_header.contents.priority
(Tezos_raw_protocol_alpha.Alpha_context.Block_header.protocol_data.contents
(Tezos_raw_protocol_alpha.Alpha_context.Block_header.t.protocol_data
block_header))))
(fun ctxt =>
let current_level := Alpha_context.Level.current ctxt in
op_gtgteqquestion (Baking.check_proof_of_work_stamp ctxt block_header)
(fun function_parameter =>
let 'tt := function_parameter in
op_gtgteqquestion (Baking.check_fitness_gap ctxt block_header)
(fun function_parameter =>
let 'tt := function_parameter in
op_gtgteqquestion
(Baking.check_baking_rights ctxt
(Tezos_raw_protocol_alpha.Alpha_context.Block_header.protocol_data.contents
(Tezos_raw_protocol_alpha.Alpha_context.Block_header.t.protocol_data
block_header)) pred_timestamp)
(fun function_parameter =>
let '(delegate_pk, block_delay) := function_parameter in
op_gtgteqquestion
(Baking.check_signature block_header chain_id delegate_pk)
(fun function_parameter =>
let 'tt := function_parameter in
let has_commitment :=
match
Tezos_raw_protocol_alpha.Alpha_context.Block_header.contents.seed_nonce_hash
(Tezos_raw_protocol_alpha.Alpha_context.Block_header.protocol_data.contents
(Tezos_raw_protocol_alpha.Alpha_context.Block_header.t.protocol_data
block_header)) with
| None => false
| Some _ => true
end in
op_gtgteqquestion
(fail_unless
(op_eq has_commitment
(Tezos_raw_protocol_alpha.Alpha_context.Level.t.expected_commitment
current_level))
(Tezos_protocol_environment_alpha__Environment.Error_monad.Invalid_commitment
{|
Invalid_commitment.expected :=
Tezos_raw_protocol_alpha.Alpha_context.Level.t.expected_commitment
current_level |}))
(fun function_parameter =>
let 'tt := function_parameter in
let ctxt := Fitness.increase None ctxt in
match Level.pred ctxt (Level.current ctxt) with
| None =>
(* ❌ Assert instruction is not handled. *)
assert false
| Some pred_level =>
op_gtgteqquestion
(Baking.endorsement_rights ctxt pred_level)
(fun rights =>
let ctxt := init_endorsements ctxt rights in
__return (ctxt, delegate_pk, block_delay))
end)))))).
Definition check_minimum_endorsements
(ctxt : Tezos_raw_protocol_alpha.Alpha_context.context)
(protocol_data : Tezos_raw_protocol_alpha.Alpha_context.Block_header.contents)
(block_delay : Tezos_raw_protocol_alpha.Alpha_context.Period.t)
(included_endorsements :
Tezos_protocol_environment_alpha__Environment.Compare.Int.t)
: Tezos_protocol_environment_alpha__Environment.Lwt.t
(Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult unit) :=
let minimum := Baking.minimum_allowed_endorsements ctxt block_delay in
let timestamp := Timestamp.current ctxt in
fail_unless (op_gteq included_endorsements minimum)
(Tezos_protocol_environment_alpha__Environment.Error_monad.Not_enough_endorsements_for_priority
{| Not_enough_endorsements_for_priority.required := minimum;
Not_enough_endorsements_for_priority.priority :=
Tezos_raw_protocol_alpha.Alpha_context.Block_header.contents.priority
protocol_data;
Not_enough_endorsements_for_priority.endorsements :=
included_endorsements;
Not_enough_endorsements_for_priority.timestamp := timestamp |}).
Definition finalize_application
(ctxt : Tezos_raw_protocol_alpha.Alpha_context.context)
(protocol_data : Tezos_raw_protocol_alpha.Alpha_context.Block_header.contents)
(delegate :
Tezos_protocol_environment_alpha__Environment.Signature.Public_key_hash.t)
(block_delay : Tezos_raw_protocol_alpha.Alpha_context.Period.t)
: Tezos_protocol_environment_alpha__Environment.Lwt.t
(Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
(Tezos_raw_protocol_alpha.Alpha_context.context *
Tezos_raw_protocol_alpha.Apply_results.block_metadata)) :=
let included_endorsements := included_endorsements ctxt in
op_gtgteqquestion
(check_minimum_endorsements ctxt protocol_data block_delay
included_endorsements)
(fun function_parameter =>
let 'tt := function_parameter in
let deposit := Constants.block_security_deposit ctxt in
op_gtgteqquestion (add_deposit ctxt delegate deposit)
(fun ctxt =>
op_gtgteqquestion
(Baking.baking_reward ctxt
(Tezos_raw_protocol_alpha.Alpha_context.Block_header.contents.priority
protocol_data) included_endorsements)
(fun reward =>
op_gtgteqquestion (add_rewards ctxt reward)
(fun ctxt =>
op_gtgteqquestion
(Signature.Public_key_hash.Map.fold
(fun delegate =>
fun deposit =>
fun ctxt =>
op_gtgteqquestion ctxt
(fun ctxt =>
Delegate.freeze_deposit ctxt delegate deposit))
(get_deposits ctxt) (__return ctxt))
(fun ctxt =>
let fees := Alpha_context.get_fees ctxt in
op_gtgteqquestion
(Delegate.freeze_fees ctxt delegate fees)
(fun ctxt =>
let rewards := Alpha_context.get_rewards ctxt in
op_gtgteqquestion
(Delegate.freeze_rewards ctxt delegate rewards)
(fun ctxt =>
op_gtgteqquestion
match
Tezos_raw_protocol_alpha.Alpha_context.Block_header.contents.seed_nonce_hash
protocol_data with
| None => __return ctxt
| Some nonce_hash =>
Nonce.record_hash ctxt
{|
Tezos_raw_protocol_alpha.Alpha_context.Nonce.unrevealed.nonce_hash :=
nonce_hash;
Tezos_raw_protocol_alpha.Alpha_context.Nonce.unrevealed.delegate :=
delegate;
Tezos_raw_protocol_alpha.Alpha_context.Nonce.unrevealed.rewards :=
rewards;
Tezos_raw_protocol_alpha.Alpha_context.Nonce.unrevealed.fees :=
fees |}
end
(fun ctxt =>
op_gtgteqquestion (may_snapshot_roll ctxt)
(fun ctxt =>
op_gtgteqquestion
(may_start_new_cycle ctxt)
(fun function_parameter =>
let
'(ctxt, balance_updates, deactivated) :=
function_parameter in
op_gtgteqquestion
(Amendment.may_start_new_voting_period
ctxt)
(fun ctxt =>
let cycle :=
Tezos_raw_protocol_alpha.Alpha_context.Level.t.cycle
(Level.current ctxt) in
let balance_updates :=
cleanup_balance_updates
(op_at
(cons
((Tezos_raw_protocol_alpha.Alpha_context.Delegate.Contract
(Contract.implicit_contract
delegate)),
(Tezos_raw_protocol_alpha.Alpha_context.Delegate.Debited
deposit))
(cons
((Tezos_raw_protocol_alpha.Alpha_context.Delegate.Deposits
delegate cycle),
(Tezos_raw_protocol_alpha.Alpha_context.Delegate.Credited
deposit))
(cons
((Tezos_raw_protocol_alpha.Alpha_context.Delegate.Rewards
delegate cycle),
(Tezos_raw_protocol_alpha.Alpha_context.Delegate.Credited
reward)) [])))
balance_updates) in
let consumed_gas :=
Z.sub
(Constants.hard_gas_limit_per_block
ctxt)
(Alpha_context.Gas.block_level
ctxt) in
op_gtgteqquestion
(Alpha_context.Vote.get_current_period_kind
ctxt)
(fun voting_period_kind =>
let receipt :=
{|
Tezos_raw_protocol_alpha.Apply_results.block_metadata.baker :=
delegate;
Tezos_raw_protocol_alpha.Apply_results.block_metadata.level :=
Level.current ctxt;
Tezos_raw_protocol_alpha.Apply_results.block_metadata.voting_period_kind :=
voting_period_kind;
Tezos_raw_protocol_alpha.Apply_results.block_metadata.nonce_hash :=
Tezos_raw_protocol_alpha.Alpha_context.Block_header.contents.seed_nonce_hash
protocol_data;
Tezos_raw_protocol_alpha.Apply_results.block_metadata.consumed_gas :=
consumed_gas;
Tezos_raw_protocol_alpha.Apply_results.block_metadata.deactivated :=
deactivated;
Tezos_raw_protocol_alpha.Apply_results.block_metadata.balance_updates :=
balance_updates |} in
__return (ctxt, receipt))))))))))))).
apply_results.ml 22 errors
(*****************************************************************************)
(* *)
(* Open Source License *)
(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com> *)
(* *)
(* Permission is hereby granted, free of charge, to any person obtaining a *)
(* copy of this software and associated documentation files (the "Software"),*)
(* to deal in the Software without restriction, including without limitation *)
(* the rights to use, copy, modify, merge, publish, distribute, sublicense, *)
(* and/or sell copies of the Software, and to permit persons to whom the *)
(* Software is furnished to do so, subject to the following conditions: *)
(* *)
(* The above copyright notice and this permission notice shall be included *)
(* in all copies or substantial portions of the Software. *)
(* *)
(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*)
(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, *)
(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL *)
(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*)
(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING *)
(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER *)
(* DEALINGS IN THE SOFTWARE. *)
(* *)
(*****************************************************************************)
open Alpha_context
open Data_encoding
let error_encoding =
def
"error"
~description:
"The full list of RPC errors would be too long to include.\n\
It is available at RPC `/errors` (GET).\n\
Errors specific to protocol Alpha have an id that starts with \
`proto.alpha`."
@@ splitted
~json:
(conv
(fun err ->
Data_encoding.Json.construct Error_monad.error_encoding err)
(fun json ->
Data_encoding.Json.destruct Error_monad.error_encoding json)
json)
~binary:Error_monad.error_encoding
type _ successful_manager_operation_result =
| Reveal_result : {
consumed_gas : Z.t;
}
-> Kind.reveal successful_manager_operation_result
| Transaction_result : {
storage : Script.expr option;
big_map_diff : Contract.big_map_diff option;
balance_updates : Delegate.balance_updates;
originated_contracts : Contract.t list;
consumed_gas : Z.t;
storage_size : Z.t;
paid_storage_size_diff : Z.t;
allocated_destination_contract : bool;
}
-> Kind.transaction successful_manager_operation_result
| Origination_result : {
big_map_diff : Contract.big_map_diff option;
balance_updates : Delegate.balance_updates;
originated_contracts : Contract.t list;
consumed_gas : Z.t;
storage_size : Z.t;
paid_storage_size_diff : Z.t;
}
-> Kind.origination successful_manager_operation_result
| Delegation_result : {
consumed_gas : Z.t;
}
-> Kind.delegation successful_manager_operation_result
type packed_successful_manager_operation_result =
| Successful_manager_result :
'kind successful_manager_operation_result
-> packed_successful_manager_operation_result
type 'kind manager_operation_result =
| Applied of 'kind successful_manager_operation_result
| Backtracked of
'kind successful_manager_operation_result * error list option
| Failed : 'kind Kind.manager * error list -> 'kind manager_operation_result
| Skipped : 'kind Kind.manager -> 'kind manager_operation_result
type packed_internal_operation_result =
| Internal_operation_result :
'kind internal_operation * 'kind manager_operation_result
-> packed_internal_operation_result
module Manager_result = struct
type 'kind case =
| MCase : {
op_case : 'kind Operation.Encoding.Manager_operations.case;
encoding : 'a Data_encoding.t;
kind : 'kind Kind.manager;
iselect :
packed_internal_operation_result ->
('kind internal_operation * 'kind manager_operation_result) option;
select :
packed_successful_manager_operation_result ->
'kind successful_manager_operation_result option;
proj : 'kind successful_manager_operation_result -> 'a;
inj : 'a -> 'kind successful_manager_operation_result;
t : 'kind manager_operation_result Data_encoding.t;
}
-> 'kind case
let make ~op_case ~encoding ~kind ~iselect ~select ~proj ~inj =
let (Operation.Encoding.Manager_operations.MCase {name; _}) = op_case in
let t =
def (Format.asprintf "operation.alpha.operation_result.%s" name)
@@ union
~tag_size:`Uint8
[ case
(Tag 0)
~title:"Applied"
(merge_objs (obj1 (req "status" (constant "applied"))) encoding)
(fun o ->
match o with
| Skipped _ | Failed _ | Backtracked _ ->
None
| Applied o -> (
match select (Successful_manager_result o) with
| None ->
None
| Some o ->
Some ((), proj o) ))
(fun ((), x) -> Applied (inj x));
case
(Tag 1)
~title:"Failed"
(obj2
(req "status" (constant "failed"))
(req "errors" (list error_encoding)))
(function Failed (_, errs) -> Some ((), errs) | _ -> None)
(fun ((), errs) -> Failed (kind, errs));
case
(Tag 2)
~title:"Skipped"
(obj1 (req "status" (constant "skipped")))
(function Skipped _ -> Some () | _ -> None)
(fun () -> Skipped kind);
case
(Tag 3)
~title:"Backtracked"
(merge_objs
(obj2
(req "status" (constant "backtracked"))
(opt "errors" (list error_encoding)))
encoding)
(fun o ->
match o with
| Skipped _ | Failed _ | Applied _ ->
None
| Backtracked (o, errs) -> (
match select (Successful_manager_result o) with
| None ->
None
| Some o ->
Some (((), errs), proj o) ))
(fun (((), errs), x) -> Backtracked (inj x, errs)) ]
in
MCase {op_case; encoding; kind; iselect; select; proj; inj; t}
let reveal_case =
make
~op_case:Operation.Encoding.Manager_operations.reveal_case
~encoding:Data_encoding.(obj1 (dft "consumed_gas" z Z.zero))
~iselect:(function
| Internal_operation_result (({operation = Reveal _; _} as op), res) ->
Some (op, res)
| _ ->
None)
~select:(function
| Successful_manager_result (Reveal_result _ as op) ->
Some op
| _ ->
None)
~kind:Kind.Reveal_manager_kind
~proj:(function Reveal_result {consumed_gas} -> consumed_gas)
~inj:(fun consumed_gas -> Reveal_result {consumed_gas})
let transaction_case =
make
~op_case:Operation.Encoding.Manager_operations.transaction_case
~encoding:
(obj8
(opt "storage" Script.expr_encoding)
(opt "big_map_diff" Contract.big_map_diff_encoding)
(dft "balance_updates" Delegate.balance_updates_encoding [])
(dft "originated_contracts" (list Contract.encoding) [])
(dft "consumed_gas" z Z.zero)
(dft "storage_size" z Z.zero)
(dft "paid_storage_size_diff" z Z.zero)
(dft "allocated_destination_contract" bool false))
~iselect:(function
| Internal_operation_result
(({operation = Transaction _; _} as op), res) ->
Some (op, res)
| _ ->
None)
~select:(function
| Successful_manager_result (Transaction_result _ as op) ->
Some op
| _ ->
None)
~kind:Kind.Transaction_manager_kind
~proj:(function
| Transaction_result
{ storage;
big_map_diff;
balance_updates;
originated_contracts;
consumed_gas;
storage_size;
paid_storage_size_diff;
allocated_destination_contract } ->
( storage,
big_map_diff,
balance_updates,
originated_contracts,
consumed_gas,
storage_size,
paid_storage_size_diff,
allocated_destination_contract ))
~inj:
(fun ( storage,
big_map_diff,
balance_updates,
originated_contracts,
consumed_gas,
storage_size,
paid_storage_size_diff,
allocated_destination_contract ) ->
Transaction_result
{
storage;
big_map_diff;
balance_updates;
originated_contracts;
consumed_gas;
storage_size;
paid_storage_size_diff;
allocated_destination_contract;
})
let origination_case =
make
~op_case:Operation.Encoding.Manager_operations.origination_case
~encoding:
(obj6
(opt "big_map_diff" Contract.big_map_diff_encoding)
(dft "balance_updates" Delegate.balance_updates_encoding [])
(dft "originated_contracts" (list Contract.encoding) [])
(dft "consumed_gas" z Z.zero)
(dft "storage_size" z Z.zero)
(dft "paid_storage_size_diff" z Z.zero))
~iselect:(function
| Internal_operation_result
(({operation = Origination _; _} as op), res) ->
Some (op, res)
| _ ->
None)
~select:(function
| Successful_manager_result (Origination_result _ as op) ->
Some op
| _ ->
None)
~proj:(function
| Origination_result
{ big_map_diff;
balance_updates;
originated_contracts;
consumed_gas;
storage_size;
paid_storage_size_diff } ->
( big_map_diff,
balance_updates,
originated_contracts,
consumed_gas,
storage_size,
paid_storage_size_diff ))
~kind:Kind.Origination_manager_kind
~inj:
(fun ( big_map_diff,
balance_updates,
originated_contracts,
consumed_gas,
storage_size,
paid_storage_size_diff ) ->
Origination_result
{
big_map_diff;
balance_updates;
originated_contracts;
consumed_gas;
storage_size;
paid_storage_size_diff;
})
let delegation_case =
make
~op_case:Operation.Encoding.Manager_operations.delegation_case
~encoding:Data_encoding.(obj1 (dft "consumed_gas" z Z.zero))
~iselect:(function
| Internal_operation_result (({operation = Delegation _; _} as op), res)
->
Some (op, res)
| _ ->
None)
~select:(function
| Successful_manager_result (Delegation_result _ as op) ->
Some op
| _ ->
None)
~kind:Kind.Delegation_manager_kind
~proj:(function Delegation_result {consumed_gas} -> consumed_gas)
~inj:(fun consumed_gas -> Delegation_result {consumed_gas})
end
let internal_operation_result_encoding :
packed_internal_operation_result Data_encoding.t =
let make (type kind)
(Manager_result.MCase res_case : kind Manager_result.case) =
let (Operation.Encoding.Manager_operations.MCase op_case) =
res_case.op_case
in
case
(Tag op_case.tag)
~title:op_case.name
(merge_objs
(obj3
(req "kind" (constant op_case.name))
(req "source" Contract.encoding)
(req "nonce" uint16))
(merge_objs op_case.encoding (obj1 (req "result" res_case.t))))
(fun op ->
match res_case.iselect op with
| Some (op, res) ->
Some (((), op.source, op.nonce), (op_case.proj op.operation, res))
| None ->
None)
(fun (((), source, nonce), (op, res)) ->
let op = {source; operation = op_case.inj op; nonce} in
Internal_operation_result (op, res))
in
def "operation.alpha.internal_operation_result"
@@ union
[ make Manager_result.reveal_case;
make Manager_result.transaction_case;
make Manager_result.origination_case;
make Manager_result.delegation_case ]
type 'kind contents_result =
| Endorsement_result : {
balance_updates : Delegate.balance_updates;
delegate : Signature.Public_key_hash.t;
slots : int list;
}
-> Kind.endorsement contents_result
| Seed_nonce_revelation_result :
Delegate.balance_updates
-> Kind.seed_nonce_revelation contents_result
| Double_endorsement_evidence_result :
Delegate.balance_updates
-> Kind.double_endorsement_evidence contents_result
| Double_baking_evidence_result :
Delegate.balance_updates
-> Kind.double_baking_evidence contents_result
| Activate_account_result :
Delegate.balance_updates
-> Kind.activate_account contents_result
| Proposals_result : Kind.proposals contents_result
| Ballot_result : Kind.ballot contents_result
| Manager_operation_result : {
balance_updates : Delegate.balance_updates;
operation_result : 'kind manager_operation_result;
internal_operation_results : packed_internal_operation_result list;
}
-> 'kind Kind.manager contents_result
type packed_contents_result =
| Contents_result : 'kind contents_result -> packed_contents_result
type packed_contents_and_result =
| Contents_and_result :
'kind Operation.contents * 'kind contents_result
-> packed_contents_and_result
type ('a, 'b) eq = Eq : ('a, 'a) eq
let equal_manager_kind :
type a b. a Kind.manager -> b Kind.manager -> (a, b) eq option =
fun ka kb ->
match (ka, kb) with
| (Kind.Reveal_manager_kind, Kind.Reveal_manager_kind) ->
Some Eq
| (Kind.Reveal_manager_kind, _) ->
None
| (Kind.Transaction_manager_kind, Kind.Transaction_manager_kind) ->
Some Eq
| (Kind.Transaction_manager_kind, _) ->
None
| (Kind.Origination_manager_kind, Kind.Origination_manager_kind) ->
Some Eq
| (Kind.Origination_manager_kind, _) ->
None
| (Kind.Delegation_manager_kind, Kind.Delegation_manager_kind) ->
Some Eq
| (Kind.Delegation_manager_kind, _) ->
None
module Encoding = struct
type 'kind case =
| Case : {
op_case : 'kind Operation.Encoding.case;
encoding : 'a Data_encoding.t;
select : packed_contents_result -> 'kind contents_result option;
mselect :
packed_contents_and_result ->
('kind contents * 'kind contents_result) option;
proj : 'kind contents_result -> 'a;
inj : 'a -> 'kind contents_result;
}
-> 'kind case
let tagged_case tag name args proj inj =
let open Data_encoding in
case
tag
~title:(String.capitalize_ascii name)
(merge_objs (obj1 (req "kind" (constant name))) args)
(fun x -> match proj x with None -> None | Some x -> Some ((), x))
(fun ((), x) -> inj x)
let endorsement_case =
Case
{
op_case = Operation.Encoding.endorsement_case;
encoding =
obj3
(req "balance_updates" Delegate.balance_updates_encoding)
(req "delegate" Signature.Public_key_hash.encoding)
(req "slots" (list uint8));
select =
(function
| Contents_result (Endorsement_result _ as op) -> Some op | _ -> None);
mselect =
(function
| Contents_and_result ((Endorsement _ as op), res) ->
Some (op, res)
| _ ->
None);
proj =
(function
| Endorsement_result {balance_updates; delegate; slots} ->
(balance_updates, delegate, slots));
inj =
(fun (balance_updates, delegate, slots) ->
Endorsement_result {balance_updates; delegate; slots});
}
let seed_nonce_revelation_case =
Case
{
op_case = Operation.Encoding.seed_nonce_revelation_case;
encoding =
obj1 (req "balance_updates" Delegate.balance_updates_encoding);
select =
(function
| Contents_result (Seed_nonce_revelation_result _ as op) ->
Some op
| _ ->
None);
mselect =
(function
| Contents_and_result ((Seed_nonce_revelation _ as op), res) ->
Some (op, res)
| _ ->
None);
proj = (fun (Seed_nonce_revelation_result bus) -> bus);
inj = (fun bus -> Seed_nonce_revelation_result bus);
}
let double_endorsement_evidence_case =
Case
{
op_case = Operation.Encoding.double_endorsement_evidence_case;
encoding =
obj1 (req "balance_updates" Delegate.balance_updates_encoding);
select =
(function
| Contents_result (Double_endorsement_evidence_result _ as op) ->
Some op
| _ ->
None);
mselect =
(function
| Contents_and_result ((Double_endorsement_evidence _ as op), res) ->
Some (op, res)
| _ ->
None);
proj = (fun (Double_endorsement_evidence_result bus) -> bus);
inj = (fun bus -> Double_endorsement_evidence_result bus);
}
let double_baking_evidence_case =
Case
{
op_case = Operation.Encoding.double_baking_evidence_case;
encoding =
obj1 (req "balance_updates" Delegate.balance_updates_encoding);
select =
(function
| Contents_result (Double_baking_evidence_result _ as op) ->
Some op
| _ ->
None);
mselect =
(function
| Contents_and_result ((Double_baking_evidence _ as op), res) ->
Some (op, res)
| _ ->
None);
proj = (fun (Double_baking_evidence_result bus) -> bus);
inj = (fun bus -> Double_baking_evidence_result bus);
}
let activate_account_case =
Case
{
op_case = Operation.Encoding.activate_account_case;
encoding =
obj1 (req "balance_updates" Delegate.balance_updates_encoding);
select =
(function
| Contents_result (Activate_account_result _ as op) ->
Some op
| _ ->
None);
mselect =
(function
| Contents_and_result ((Activate_account _ as op), res) ->
Some (op, res)
| _ ->
None);
proj = (fun (Activate_account_result bus) -> bus);
inj = (fun bus -> Activate_account_result bus);
}
let proposals_case =
Case
{
op_case = Operation.Encoding.proposals_case;
encoding = Data_encoding.empty;
select =
(function
| Contents_result (Proposals_result as op) -> Some op | _ -> None);
mselect =
(function
| Contents_and_result ((Proposals _ as op), res) ->
Some (op, res)
| _ ->
None);
proj = (fun Proposals_result -> ());
inj = (fun () -> Proposals_result);
}
let ballot_case =
Case
{
op_case = Operation.Encoding.ballot_case;
encoding = Data_encoding.empty;
select =
(function
| Contents_result (Ballot_result as op) -> Some op | _ -> None);
mselect =
(function
| Contents_and_result ((Ballot _ as op), res) ->
Some (op, res)
| _ ->
None);
proj = (fun Ballot_result -> ());
inj = (fun () -> Ballot_result);
}
let make_manager_case (type kind)
(Operation.Encoding.Case op_case :
kind Kind.manager Operation.Encoding.case)
(Manager_result.MCase res_case : kind Manager_result.case) mselect =
Case
{
op_case = Operation.Encoding.Case op_case;
encoding =
obj3
(req "balance_updates" Delegate.balance_updates_encoding)
(req "operation_result" res_case.t)
(dft
"internal_operation_results"
(list internal_operation_result_encoding)
[]);
select =
(function
| Contents_result
(Manager_operation_result
({operation_result = Applied res; _} as op)) -> (
match res_case.select (Successful_manager_result res) with
| Some res ->
Some
(Manager_operation_result
{op with operation_result = Applied res})
| None ->
None )
| Contents_result
(Manager_operation_result
({operation_result = Backtracked (res, errs); _} as op)) -> (
match res_case.select (Successful_manager_result res) with
| Some res ->
Some
(Manager_operation_result
{op with operation_result = Backtracked (res, errs)})
| None ->
None )
| Contents_result
(Manager_operation_result
({operation_result = Skipped kind; _} as op)) -> (
match equal_manager_kind kind res_case.kind with
| None ->
None
| Some Eq ->
Some
(Manager_operation_result
{op with operation_result = Skipped kind}) )
| Contents_result
(Manager_operation_result
({operation_result = Failed (kind, errs); _} as op)) -> (
match equal_manager_kind kind res_case.kind with
| None ->
None
| Some Eq ->
Some
(Manager_operation_result
{op with operation_result = Failed (kind, errs)}) )
| Contents_result Ballot_result ->
None
| Contents_result (Endorsement_result _) ->
None
| Contents_result (Seed_nonce_revelation_result _) ->
None
| Contents_result (Double_endorsement_evidence_result _) ->
None
| Contents_result (Double_baking_evidence_result _) ->
None
| Contents_result (Activate_account_result _) ->
None
| Contents_result Proposals_result ->
None);
mselect;
proj =
(fun (Manager_operation_result
{ balance_updates = bus;
operation_result = r;
internal_operation_results = rs }) ->
(bus, r, rs));
inj =
(fun (bus, r, rs) ->
Manager_operation_result
{
balance_updates = bus;
operation_result = r;
internal_operation_results = rs;
});
}
let reveal_case =
make_manager_case
Operation.Encoding.reveal_case
Manager_result.reveal_case
(function
| Contents_and_result
((Manager_operation {operation = Reveal _; _} as op), res) ->
Some (op, res)
| _ ->
None)
let transaction_case =
make_manager_case
Operation.Encoding.transaction_case
Manager_result.transaction_case
(function
| Contents_and_result
((Manager_operation {operation = Transaction _; _} as op), res) ->
Some (op, res)
| _ ->
None)
let origination_case =
make_manager_case
Operation.Encoding.origination_case
Manager_result.origination_case
(function
| Contents_and_result
((Manager_operation {operation = Origination _; _} as op), res) ->
Some (op, res)
| _ ->
None)
let delegation_case =
make_manager_case
Operation.Encoding.delegation_case
Manager_result.delegation_case
(function
| Contents_and_result
((Manager_operation {operation = Delegation _; _} as op), res) ->
Some (op, res)
| _ ->
None)
end
let contents_result_encoding =
let open Encoding in
let make
(Case
{ op_case = Operation.Encoding.Case {tag; name; _};
encoding;
mselect = _;
select;
proj;
inj }) =
let proj x =
match select x with None -> None | Some x -> Some (proj x)
in
let inj x = Contents_result (inj x) in
tagged_case (Tag tag) name encoding proj inj
in
def "operation.alpha.contents_result"
@@ union
[ make endorsement_case;
make seed_nonce_revelation_case;
make double_endorsement_evidence_case;
make double_baking_evidence_case;
make activate_account_case;
make proposals_case;
make ballot_case;
make reveal_case;
make transaction_case;
make origination_case;
make delegation_case ]
let contents_and_result_encoding =
let open Encoding in
let make
(Case
{ op_case = Operation.Encoding.Case {tag; name; encoding; proj; inj; _};
mselect;
encoding = meta_encoding;
proj = meta_proj;
inj = meta_inj;
_ }) =
let proj c =
match mselect c with
| Some (op, res) ->
Some (proj op, meta_proj res)
| _ ->
None
in
let inj (op, res) = Contents_and_result (inj op, meta_inj res) in
let encoding = merge_objs encoding (obj1 (req "metadata" meta_encoding)) in
tagged_case (Tag tag) name encoding proj inj
in
def "operation.alpha.operation_contents_and_result"
@@ union
[ make endorsement_case;
make seed_nonce_revelation_case;
make double_endorsement_evidence_case;
make double_baking_evidence_case;
make activate_account_case;
make proposals_case;
make ballot_case;
make reveal_case;
make transaction_case;
make origination_case;
make delegation_case ]
type 'kind contents_result_list =
| Single_result : 'kind contents_result -> 'kind contents_result_list
| Cons_result :
'kind Kind.manager contents_result
* 'rest Kind.manager contents_result_list
-> ('kind * 'rest) Kind.manager contents_result_list
type packed_contents_result_list =
| Contents_result_list :
'kind contents_result_list
-> packed_contents_result_list
let contents_result_list_encoding =
let rec to_list = function
| Contents_result_list (Single_result o) ->
[Contents_result o]
| Contents_result_list (Cons_result (o, os)) ->
Contents_result o :: to_list (Contents_result_list os)
in
let rec of_list = function
| [] ->
Pervasives.failwith "cannot decode empty operation result"
| [Contents_result o] ->
Contents_result_list (Single_result o)
| Contents_result o :: os -> (
let (Contents_result_list os) = of_list os in
match (o, os) with
| ( Manager_operation_result _,
Single_result (Manager_operation_result _) ) ->
Contents_result_list (Cons_result (o, os))
| (Manager_operation_result _, Cons_result _) ->
Contents_result_list (Cons_result (o, os))
| _ ->
Pervasives.failwith "cannot decode ill-formed operation result" )
in
def "operation.alpha.contents_list_result"
@@ conv to_list of_list (list contents_result_encoding)
type 'kind contents_and_result_list =
| Single_and_result :
'kind Alpha_context.contents * 'kind contents_result
-> 'kind contents_and_result_list
| Cons_and_result :
'kind Kind.manager Alpha_context.contents
* 'kind Kind.manager contents_result
* 'rest Kind.manager contents_and_result_list
-> ('kind * 'rest) Kind.manager contents_and_result_list
type packed_contents_and_result_list =
| Contents_and_result_list :
'kind contents_and_result_list
-> packed_contents_and_result_list
let contents_and_result_list_encoding =
let rec to_list = function
| Contents_and_result_list (Single_and_result (op, res)) ->
[Contents_and_result (op, res)]
| Contents_and_result_list (Cons_and_result (op, res, rest)) ->
Contents_and_result (op, res)
:: to_list (Contents_and_result_list rest)
in
let rec of_list = function
| [] ->
Pervasives.failwith "cannot decode empty combined operation result"
| [Contents_and_result (op, res)] ->
Contents_and_result_list (Single_and_result (op, res))
| Contents_and_result (op, res) :: rest -> (
let (Contents_and_result_list rest) = of_list rest in
match (op, rest) with
| (Manager_operation _, Single_and_result (Manager_operation _, _)) ->
Contents_and_result_list (Cons_and_result (op, res, rest))
| (Manager_operation _, Cons_and_result (_, _, _)) ->
Contents_and_result_list (Cons_and_result (op, res, rest))
| _ ->
Pervasives.failwith
"cannot decode ill-formed combined operation result" )
in
conv to_list of_list (Variable.list contents_and_result_encoding)
type 'kind operation_metadata = {contents : 'kind contents_result_list}
type packed_operation_metadata =
| Operation_metadata : 'kind operation_metadata -> packed_operation_metadata
| No_operation_metadata : packed_operation_metadata
let operation_metadata_encoding =
def "operation.alpha.result"
@@ union
[ case
(Tag 0)
~title:"Operation_metadata"
contents_result_list_encoding
(function
| Operation_metadata {contents} ->
Some (Contents_result_list contents)
| _ ->
None)
(fun (Contents_result_list contents) ->
Operation_metadata {contents});
case
(Tag 1)
~title:"No_operation_metadata"
empty
(function No_operation_metadata -> Some () | _ -> None)
(fun () -> No_operation_metadata) ]
let kind_equal :
type kind kind2.
kind contents -> kind2 contents_result -> (kind, kind2) eq option =
fun op res ->
match (op, res) with
| (Endorsement _, Endorsement_result _) ->
Some Eq
| (Endorsement _, _) ->
None
| (Seed_nonce_revelation _, Seed_nonce_revelation_result _) ->
Some Eq
| (Seed_nonce_revelation _, _) ->
None
| (Double_endorsement_evidence _, Double_endorsement_evidence_result _) ->
Some Eq
| (Double_endorsement_evidence _, _) ->
None
| (Double_baking_evidence _, Double_baking_evidence_result _) ->
Some Eq
| (Double_baking_evidence _, _) ->
None
| (Activate_account _, Activate_account_result _) ->
Some Eq
| (Activate_account _, _) ->
None
| (Proposals _, Proposals_result) ->
Some Eq
| (Proposals _, _) ->
None
| (Ballot _, Ballot_result) ->
Some Eq
| (Ballot _, _) ->
None
| ( Manager_operation {operation = Reveal _; _},
Manager_operation_result {operation_result = Applied (Reveal_result _); _}
) ->
Some Eq
| ( Manager_operation {operation = Reveal _; _},
Manager_operation_result
{operation_result = Backtracked (Reveal_result _, _); _} ) ->
Some Eq
| ( Manager_operation {operation = Reveal _; _},
Manager_operation_result
{ operation_result = Failed (Alpha_context.Kind.Reveal_manager_kind, _);
_ } ) ->
Some Eq
| ( Manager_operation {operation = Reveal _; _},
Manager_operation_result
{operation_result = Skipped Alpha_context.Kind.Reveal_manager_kind; _}
) ->
Some Eq
| (Manager_operation {operation = Reveal _; _}, _) ->
None
| ( Manager_operation {operation = Transaction _; _},
Manager_operation_result
{operation_result = Applied (Transaction_result _); _} ) ->
Some Eq
| ( Manager_operation {operation = Transaction _; _},
Manager_operation_result
{operation_result = Backtracked (Transaction_result _, _); _} ) ->
Some Eq
| ( Manager_operation {operation = Transaction _; _},
Manager_operation_result
{ operation_result =
Failed (Alpha_context.Kind.Transaction_manager_kind, _);
_ } ) ->
Some Eq
| ( Manager_operation {operation = Transaction _; _},
Manager_operation_result
{ operation_result = Skipped Alpha_context.Kind.Transaction_manager_kind;
_ } ) ->
Some Eq
| (Manager_operation {operation = Transaction _; _}, _) ->
None
| ( Manager_operation {operation = Origination _; _},
Manager_operation_result
{operation_result = Applied (Origination_result _); _} ) ->
Some Eq
| ( Manager_operation {operation = Origination _; _},
Manager_operation_result
{operation_result = Backtracked (Origination_result _, _); _} ) ->
Some Eq
| ( Manager_operation {operation = Origination _; _},
Manager_operation_result
{ operation_result =
Failed (Alpha_context.Kind.Origination_manager_kind, _);
_ } ) ->
Some Eq
| ( Manager_operation {operation = Origination _; _},
Manager_operation_result
{ operation_result = Skipped Alpha_context.Kind.Origination_manager_kind;
_ } ) ->
Some Eq
| (Manager_operation {operation = Origination _; _}, _) ->
None
| ( Manager_operation {operation = Delegation _; _},
Manager_operation_result
{operation_result = Applied (Delegation_result _); _} ) ->
Some Eq
| ( Manager_operation {operation = Delegation _; _},
Manager_operation_result
{operation_result = Backtracked (Delegation_result _, _); _} ) ->
Some Eq
| ( Manager_operation {operation = Delegation _; _},
Manager_operation_result
{ operation_result =
Failed (Alpha_context.Kind.Delegation_manager_kind, _);
_ } ) ->
Some Eq
| ( Manager_operation {operation = Delegation _; _},
Manager_operation_result
{ operation_result = Skipped Alpha_context.Kind.Delegation_manager_kind;
_ } ) ->
Some Eq
| (Manager_operation {operation = Delegation _; _}, _) ->
None
let rec kind_equal_list :
type kind kind2.
kind contents_list -> kind2 contents_result_list -> (kind, kind2) eq option
=
fun contents res ->
match (contents, res) with
| (Single op, Single_result res) -> (
match kind_equal op res with None -> None | Some Eq -> Some Eq )
| (Cons (op, ops), Cons_result (res, ress)) -> (
match kind_equal op res with
| None ->
None
| Some Eq -> (
match kind_equal_list ops ress with None -> None | Some Eq -> Some Eq ) )
| _ ->
None
let rec pack_contents_list :
type kind.
kind contents_list ->
kind contents_result_list ->
kind contents_and_result_list =
fun contents res ->
match (contents, res) with
| (Single op, Single_result res) ->
Single_and_result (op, res)
| (Cons (op, ops), Cons_result (res, ress)) ->
Cons_and_result (op, res, pack_contents_list ops ress)
| ( Single (Manager_operation _),
Cons_result (Manager_operation_result _, Single_result _) ) ->
.
| ( Cons (_, _),
Single_result (Manager_operation_result {operation_result = Failed _; _})
) ->
.
| ( Cons (_, _),
Single_result
(Manager_operation_result {operation_result = Skipped _; _}) ) ->
.
| ( Cons (_, _),
Single_result
(Manager_operation_result {operation_result = Applied _; _}) ) ->
.
| ( Cons (_, _),
Single_result
(Manager_operation_result {operation_result = Backtracked _; _}) ) ->
.
| (Single _, Cons_result _) ->
.
let rec unpack_contents_list :
type kind.
kind contents_and_result_list ->
kind contents_list * kind contents_result_list = function
| Single_and_result (op, res) ->
(Single op, Single_result res)
| Cons_and_result (op, res, rest) ->
let (ops, ress) = unpack_contents_list rest in
(Cons (op, ops), Cons_result (res, ress))
let rec to_list = function
| Contents_result_list (Single_result o) ->
[Contents_result o]
| Contents_result_list (Cons_result (o, os)) ->
Contents_result o :: to_list (Contents_result_list os)
let rec of_list = function
| [] ->
assert false
| [Contents_result o] ->
Contents_result_list (Single_result o)
| Contents_result o :: os -> (
let (Contents_result_list os) = of_list os in
match (o, os) with
| (Manager_operation_result _, Single_result (Manager_operation_result _))
->
Contents_result_list (Cons_result (o, os))
| (Manager_operation_result _, Cons_result _) ->
Contents_result_list (Cons_result (o, os))
| _ ->
Pervasives.failwith
"Operation result list of length > 1 should only contains manager \
operations result." )
let operation_data_and_metadata_encoding =
def "operation.alpha.operation_with_metadata"
@@ union
[ case
(Tag 0)
~title:"Operation_with_metadata"
(obj2
(req "contents" (dynamic_size contents_and_result_list_encoding))
(opt "signature" Signature.encoding))
(function
| (Operation_data _, No_operation_metadata) ->
None
| (Operation_data op, Operation_metadata res) -> (
match kind_equal_list op.contents res.contents with
| None ->
Pervasives.failwith
"cannot decode inconsistent combined operation result"
| Some Eq ->
Some
( Contents_and_result_list
(pack_contents_list op.contents res.contents),
op.signature ) ))
(fun (Contents_and_result_list contents, signature) ->
let (op_contents, res_contents) = unpack_contents_list contents in
( Operation_data {contents = op_contents; signature},
Operation_metadata {contents = res_contents} ));
case
(Tag 1)
~title:"Operation_without_metadata"
(obj2
(req "contents" (dynamic_size Operation.contents_list_encoding))
(opt "signature" Signature.encoding))
(function
| (Operation_data op, No_operation_metadata) ->
Some (Contents_list op.contents, op.signature)
| (Operation_data _, Operation_metadata _) ->
None)
(fun (Contents_list contents, signature) ->
(Operation_data {contents; signature}, No_operation_metadata)) ]
type block_metadata = {
baker : Signature.Public_key_hash.t;
level : Level.t;
voting_period_kind : Voting_period.kind;
nonce_hash : Nonce_hash.t option;
consumed_gas : Z.t;
deactivated : Signature.Public_key_hash.t list;
balance_updates : Delegate.balance_updates;
}
let block_metadata_encoding =
let open Data_encoding in
def "block_header.alpha.metadata"
@@ conv
(fun { baker;
level;
voting_period_kind;
nonce_hash;
consumed_gas;
deactivated;
balance_updates } ->
( baker,
level,
voting_period_kind,
nonce_hash,
consumed_gas,
deactivated,
balance_updates ))
(fun ( baker,
level,
voting_period_kind,
nonce_hash,
consumed_gas,
deactivated,
balance_updates ) ->
{
baker;
level;
voting_period_kind;
nonce_hash;
consumed_gas;
deactivated;
balance_updates;
})
(obj7
(req "baker" Signature.Public_key_hash.encoding)
(req "level" Level.encoding)
(req "voting_period_kind" Voting_period.kind_encoding)
(req "nonce_hash" (option Nonce_hash.encoding))
(req "consumed_gas" (check_size 10 n))
(req "deactivated" (list Signature.Public_key_hash.encoding))
(req "balance_updates" Delegate.balance_updates_encoding))
apply_results_ml.v
Require Import OCaml.OCaml.
Local Open Scope Z_scope.
Local Open Scope type_scope.
Import ListNotations.
Import Alpha_context.
Import Data_encoding.
Definition error_encoding
: Tezos_protocol_environment_alpha__Environment.Data_encoding.encoding
Tezos_protocol_environment_alpha__Environment.Error_monad.__error :=
op_atat
(let arg :=
def "error" % string
(* ❌ expected an argument *)
expected_argument
(Some
"The full list of RPC errors would be too long to include.
It is available at RPC `/errors` (GET).
Errors specific to protocol Alpha have an id that starts with `proto.alpha`."
% string) in
fun eta => arg None eta)
(splitted
(conv
(fun err => Data_encoding.Json.construct Error_monad.error_encoding err)
(fun __json_value =>
Data_encoding.Json.destruct Error_monad.error_encoding __json_value)
None __json_value) Error_monad.error_encoding).
Reserved Notation "'successful_manager_operation_result".
Inductive successful_manager_operation_result_gadt : Set :=
| Reveal_result :
Tezos_protocol_environment_alpha__Environment.Z.t ->
successful_manager_operation_result_gadt
| Transaction_result :
option Tezos_raw_protocol_alpha.Alpha_context.Script.expr ->
option Tezos_raw_protocol_alpha.Alpha_context.Contract.big_map_diff ->
Tezos_raw_protocol_alpha.Alpha_context.Delegate.balance_updates ->
list Tezos_raw_protocol_alpha.Alpha_context.Contract.t ->
Tezos_protocol_environment_alpha__Environment.Z.t ->
Tezos_protocol_environment_alpha__Environment.Z.t ->
Tezos_protocol_environment_alpha__Environment.Z.t -> bool ->
successful_manager_operation_result_gadt
| Origination_result :
option Tezos_raw_protocol_alpha.Alpha_context.Contract.big_map_diff ->
Tezos_raw_protocol_alpha.Alpha_context.Delegate.balance_updates ->
list Tezos_raw_protocol_alpha.Alpha_context.Contract.t ->
Tezos_protocol_environment_alpha__Environment.Z.t ->
Tezos_protocol_environment_alpha__Environment.Z.t ->
Tezos_protocol_environment_alpha__Environment.Z.t ->
successful_manager_operation_result_gadt
| Delegation_result :
Tezos_protocol_environment_alpha__Environment.Z.t ->
successful_manager_operation_result_gadt
where "'successful_manager_operation_result" := (fun (_ : Set) =>
successful_manager_operation_result_gadt).
Definition successful_manager_operation_result :=
'successful_manager_operation_result.
Reserved Notation "'packed_successful_manager_operation_result".
Inductive packed_successful_manager_operation_result_gadt : Set :=
| Successful_manager_result : forall {kind : Set},
successful_manager_operation_result kind ->
packed_successful_manager_operation_result_gadt
where "'packed_successful_manager_operation_result" :=
(packed_successful_manager_operation_result_gadt).
Definition packed_successful_manager_operation_result :=
'packed_successful_manager_operation_result.
Reserved Notation "'manager_operation_result".
Inductive manager_operation_result_gadt : Set :=
| Applied : forall {kind : Set},
successful_manager_operation_result kind -> manager_operation_result_gadt
| Backtracked : forall {kind : Set},
successful_manager_operation_result kind ->
option
(list Tezos_protocol_environment_alpha__Environment.Error_monad.__error) ->
manager_operation_result_gadt
| Failed : forall {kind : Set},
Tezos_raw_protocol_alpha.Alpha_context.Kind.manager kind ->
list Tezos_protocol_environment_alpha__Environment.Error_monad.__error ->
manager_operation_result_gadt
| Skipped : forall {kind : Set},
Tezos_raw_protocol_alpha.Alpha_context.Kind.manager kind ->
manager_operation_result_gadt
where "'manager_operation_result" := (fun (kind : Set) =>
manager_operation_result_gadt).
Definition manager_operation_result := 'manager_operation_result.
Reserved Notation "'packed_internal_operation_result".
Inductive packed_internal_operation_result_gadt : Set :=
| Internal_operation_result : forall {kind : Set},
Tezos_raw_protocol_alpha.Alpha_context.internal_operation kind ->
manager_operation_result kind -> packed_internal_operation_result_gadt
where "'packed_internal_operation_result" :=
(packed_internal_operation_result_gadt).
Definition packed_internal_operation_result :=
'packed_internal_operation_result.
Module Manager_result.
Reserved Notation "'case".
Inductive case_gadt : Set :=
| MCase : forall {a kind : Set},
Tezos_raw_protocol_alpha.Alpha_context.Operation.Encoding.Manager_operations.case
kind -> Tezos_protocol_environment_alpha__Environment.Data_encoding.t a ->
Tezos_raw_protocol_alpha.Alpha_context.Kind.manager kind ->
(packed_internal_operation_result ->
option
(Tezos_raw_protocol_alpha.Alpha_context.internal_operation kind *
manager_operation_result kind)) ->
(packed_successful_manager_operation_result ->
option (successful_manager_operation_result kind)) ->
(successful_manager_operation_result kind -> a) ->
(a -> successful_manager_operation_result kind) ->
Tezos_protocol_environment_alpha__Environment.Data_encoding.t
(manager_operation_result kind) -> case_gadt
where "'case" := (fun (kind : Set) => case_gadt).
Definition case := 'case.
Definition make {A B : Set}
(op_case :
Tezos_raw_protocol_alpha.Alpha_context.Operation.Encoding.Manager_operations.case
A)
(encoding :
Tezos_protocol_environment_alpha__Environment.Data_encoding.encoding B)
(kind : Tezos_raw_protocol_alpha.Alpha_context.Kind.manager A)
(iselect :
packed_internal_operation_result ->
option
(Tezos_raw_protocol_alpha.Alpha_context.internal_operation A *
manager_operation_result A))
(select :
packed_successful_manager_operation_result ->
option (successful_manager_operation_result A))
(proj : successful_manager_operation_result A -> B)
(inj : B -> successful_manager_operation_result A) : case A :=
let
'Tezos_raw_protocol_alpha.Alpha_context.Operation.Encoding.Manager_operations.MCase
{|
Tezos_raw_protocol_alpha.Alpha_context.Operation.Encoding.Manager_operations.case.MCase.name
:= name
|} := op_case in
let t :=
op_atat
(let arg :=
def
(Format.asprintf
(Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Format
(Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.String_literal
"operation.alpha.operation_result." % string
(Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.String
Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.No_padding
Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.End_of_format))
"operation.alpha.operation_result.%s" % string) name) in
fun eta => arg None None eta)
(union
(Some
(* ❌ Variants not supported *)
variant)
(cons
(__case_value "Applied" % string None
(Tezos_protocol_environment_alpha__Environment.Data_encoding.Tag 0)
(merge_objs
(obj1
(req None None "status" % string (constant "applied" % string)))
encoding)
(fun o =>
match o with
| Skipped _ | Failed _ _ | Backtracked _ _ => None
| Applied o =>
match select (Successful_manager_result o) with
| None => None
| Some o => Some (tt, (proj o))
end
end)
(fun function_parameter =>
let '(tt, x) := function_parameter in
Applied (inj x)))
(cons
(__case_value "Failed" % string None
(Tezos_protocol_environment_alpha__Environment.Data_encoding.Tag
1)
(obj2
(req None None "status" % string (constant "failed" % string))
(req None None "errors" % string
(__list_value None error_encoding)))
(fun function_parameter =>
match function_parameter with
| Failed _ errs => Some (tt, errs)
| _ => None
end)
(fun function_parameter =>
let '(tt, errs) := function_parameter in
Failed kind errs))
(cons
(__case_value "Skipped" % string None
(Tezos_protocol_environment_alpha__Environment.Data_encoding.Tag
2)
(obj1
(req None None "status" % string
(constant "skipped" % string)))
(fun function_parameter =>
match function_parameter with
| Skipped _ => Some tt
| _ => None
end)
(fun function_parameter =>
let 'tt := function_parameter in
Skipped kind))
(cons
(__case_value "Backtracked" % string None
(Tezos_protocol_environment_alpha__Environment.Data_encoding.Tag
3)
(merge_objs
(obj2
(req None None "status" % string
(constant "backtracked" % string))
(opt None None "errors" % string
(__list_value None error_encoding))) encoding)
(fun o =>
match o with
| Skipped _ | Failed _ _ | Applied _ => None
| Backtracked o errs =>
match select (Successful_manager_result o) with
| None => None
| Some o => Some ((tt, errs), (proj o))
end
end)
(fun function_parameter =>
let '((tt, errs), x) := function_parameter in
Backtracked (inj x) errs)) []))))) in
MCase
{| case.MCase.op_case := op_case; case.MCase.encoding := encoding;
case.MCase.kind := kind; case.MCase.iselect := iselect;
case.MCase.select := select; case.MCase.proj := proj;
case.MCase.inj := inj; case.MCase.t := t |}.
Definition reveal_case
: case Tezos_raw_protocol_alpha.Alpha_context.Kind.reveal :=
make Operation.Encoding.Manager_operations.reveal_case
(obj1 (dft None None "consumed_gas" % string z Z.zero))
Tezos_raw_protocol_alpha.Alpha_context.Kind.Reveal_manager_kind
(fun function_parameter =>
match function_parameter with
|
Internal_operation_result
({|
Tezos_raw_protocol_alpha.Alpha_context.internal_operation.operation :=
Tezos_raw_protocol_alpha.Alpha_context.Reveal _
|} as op) res => Some (op, res)
| _ => None
end)
(fun function_parameter =>
match function_parameter with
| Successful_manager_result ((Reveal_result _) as op) => Some op
| _ => None
end)
(fun function_parameter =>
let
'Reveal_result {|
successful_manager_operation_result.Reveal_result.consumed_gas := consumed_gas
|} := function_parameter in
consumed_gas)
(fun consumed_gas =>
Reveal_result
{|
successful_manager_operation_result.Reveal_result.consumed_gas :=
consumed_gas |}).
Definition transaction_case
: case Tezos_raw_protocol_alpha.Alpha_context.Kind.transaction :=
make Operation.Encoding.Manager_operations.transaction_case
(obj8 (opt None None "storage" % string Script.expr_encoding)
(opt None None "big_map_diff" % string Contract.big_map_diff_encoding)
(dft None None "balance_updates" % string
Delegate.balance_updates_encoding [])
(dft None None "originated_contracts" % string
(__list_value None Contract.encoding) [])
(dft None None "consumed_gas" % string z Z.zero)
(dft None None "storage_size" % string z Z.zero)
(dft None None "paid_storage_size_diff" % string z Z.zero)
(dft None None "allocated_destination_contract" % string __bool_value
false))
Tezos_raw_protocol_alpha.Alpha_context.Kind.Transaction_manager_kind
(fun function_parameter =>
match function_parameter with
|
Internal_operation_result
({|
Tezos_raw_protocol_alpha.Alpha_context.internal_operation.operation :=
Tezos_raw_protocol_alpha.Alpha_context.Transaction _
|} as op) res => Some (op, res)
| _ => None
end)
(fun function_parameter =>
match function_parameter with
| Successful_manager_result ((Transaction_result _) as op) => Some op
| _ => None
end)
(fun function_parameter =>
let
'Transaction_result {|
successful_manager_operation_result.Transaction_result.storage := storage;
successful_manager_operation_result.Transaction_result.big_map_diff
:= big_map_diff;
successful_manager_operation_result.Transaction_result.balance_updates
:= balance_updates;
successful_manager_operation_result.Transaction_result.originated_contracts
:= originated_contracts;
successful_manager_operation_result.Transaction_result.consumed_gas
:= consumed_gas;
successful_manager_operation_result.Transaction_result.storage_size
:= storage_size;
successful_manager_operation_result.Transaction_result.paid_storage_size_diff
:= paid_storage_size_diff;
successful_manager_operation_result.Transaction_result.allocated_destination_contract
:= allocated_destination_contract
|} := function_parameter in
(storage, big_map_diff, balance_updates, originated_contracts,
consumed_gas, storage_size, paid_storage_size_diff,
allocated_destination_contract))
(fun function_parameter =>
let
'(storage, big_map_diff, balance_updates, originated_contracts,
consumed_gas, storage_size, paid_storage_size_diff,
allocated_destination_contract) := function_parameter in
Transaction_result
{|
successful_manager_operation_result.Transaction_result.storage :=
storage;
successful_manager_operation_result.Transaction_result.big_map_diff :=
big_map_diff;
successful_manager_operation_result.Transaction_result.balance_updates :=
balance_updates;
successful_manager_operation_result.Transaction_result.originated_contracts :=
originated_contracts;
successful_manager_operation_result.Transaction_result.consumed_gas :=
consumed_gas;
successful_manager_operation_result.Transaction_result.storage_size :=
storage_size;
successful_manager_operation_result.Transaction_result.paid_storage_size_diff :=
paid_storage_size_diff;
successful_manager_operation_result.Transaction_result.allocated_destination_contract :=
allocated_destination_contract |}).
Definition origination_case
: case Tezos_raw_protocol_alpha.Alpha_context.Kind.origination :=
make Operation.Encoding.Manager_operations.origination_case
(obj6
(opt None None "big_map_diff" % string Contract.big_map_diff_encoding)
(dft None None "balance_updates" % string
Delegate.balance_updates_encoding [])
(dft None None "originated_contracts" % string
(__list_value None Contract.encoding) [])
(dft None None "consumed_gas" % string z Z.zero)
(dft None None "storage_size" % string z Z.zero)
(dft None None "paid_storage_size_diff" % string z Z.zero))
Tezos_raw_protocol_alpha.Alpha_context.Kind.Origination_manager_kind
(fun function_parameter =>
match function_parameter with
|
Internal_operation_result
({|
Tezos_raw_protocol_alpha.Alpha_context.internal_operation.operation :=
Tezos_raw_protocol_alpha.Alpha_context.Origination _
|} as op) res => Some (op, res)
| _ => None
end)
(fun function_parameter =>
match function_parameter with
| Successful_manager_result ((Origination_result _) as op) => Some op
| _ => None
end)
(fun function_parameter =>
let
'Origination_result {|
successful_manager_operation_result.Origination_result.big_map_diff :=
big_map_diff;
successful_manager_operation_result.Origination_result.balance_updates
:= balance_updates;
successful_manager_operation_result.Origination_result.originated_contracts
:= originated_contracts;
successful_manager_operation_result.Origination_result.consumed_gas
:= consumed_gas;
successful_manager_operation_result.Origination_result.storage_size
:= storage_size;
successful_manager_operation_result.Origination_result.paid_storage_size_diff
:= paid_storage_size_diff
|} := function_parameter in
(big_map_diff, balance_updates, originated_contracts, consumed_gas,
storage_size, paid_storage_size_diff))
(fun function_parameter =>
let
'(big_map_diff, balance_updates, originated_contracts, consumed_gas,
storage_size, paid_storage_size_diff) := function_parameter in
Origination_result
{|
successful_manager_operation_result.Origination_result.big_map_diff :=
big_map_diff;
successful_manager_operation_result.Origination_result.balance_updates :=
balance_updates;
successful_manager_operation_result.Origination_result.originated_contracts :=
originated_contracts;
successful_manager_operation_result.Origination_result.consumed_gas :=
consumed_gas;
successful_manager_operation_result.Origination_result.storage_size :=
storage_size;
successful_manager_operation_result.Origination_result.paid_storage_size_diff :=
paid_storage_size_diff |}).
Definition delegation_case
: case Tezos_raw_protocol_alpha.Alpha_context.Kind.delegation :=
make Operation.Encoding.Manager_operations.delegation_case
(obj1 (dft None None "consumed_gas" % string z Z.zero))
Tezos_raw_protocol_alpha.Alpha_context.Kind.Delegation_manager_kind
(fun function_parameter =>
match function_parameter with
|
Internal_operation_result
({|
Tezos_raw_protocol_alpha.Alpha_context.internal_operation.operation :=
Tezos_raw_protocol_alpha.Alpha_context.Delegation _
|} as op) res => Some (op, res)
| _ => None
end)
(fun function_parameter =>
match function_parameter with
| Successful_manager_result ((Delegation_result _) as op) => Some op
| _ => None
end)
(fun function_parameter =>
let
'Delegation_result {|
successful_manager_operation_result.Delegation_result.consumed_gas :=
consumed_gas
|} := function_parameter in
consumed_gas)
(fun consumed_gas =>
Delegation_result
{|
successful_manager_operation_result.Delegation_result.consumed_gas :=
consumed_gas |}).
End Manager_result.
Definition internal_operation_result_encoding
: Tezos_protocol_environment_alpha__Environment.Data_encoding.t
packed_internal_operation_result :=
let make {A : Set} (function_parameter : Manager_result.case A)
: Tezos_protocol_environment_alpha__Environment.Data_encoding.case
packed_internal_operation_result :=
let 'Manager_result.MCase res_case := function_parameter in
let
'Tezos_raw_protocol_alpha.Alpha_context.Operation.Encoding.Manager_operations.MCase
op_case := Manager_result.case.MCase.op_case res_case in
__case_value
(Tezos_raw_protocol_alpha.Alpha_context.Operation.Encoding.Manager_operations.case.MCase.name
op_case) None
(Tezos_protocol_environment_alpha__Environment.Data_encoding.Tag
(Tezos_raw_protocol_alpha.Alpha_context.Operation.Encoding.Manager_operations.case.MCase.tag
op_case))
(merge_objs
(obj3
(req None None "kind" % string
(constant
(Tezos_raw_protocol_alpha.Alpha_context.Operation.Encoding.Manager_operations.case.MCase.name
op_case))) (req None None "source" % string Contract.encoding)
(req None None "nonce" % string uint16))
(merge_objs
(Tezos_raw_protocol_alpha.Alpha_context.Operation.Encoding.Manager_operations.case.MCase.encoding
op_case)
(obj1
(req None None "result" % string
(Manager_result.case.MCase.t res_case)))))
(fun op =>
match (Manager_result.case.MCase.iselect res_case) op with
| Some (op, res) =>
Some
((tt,
(Tezos_raw_protocol_alpha.Alpha_context.internal_operation.source
op),
(Tezos_raw_protocol_alpha.Alpha_context.internal_operation.nonce
op)),
(((Tezos_raw_protocol_alpha.Alpha_context.Operation.Encoding.Manager_operations.case.MCase.proj
op_case)
(Tezos_raw_protocol_alpha.Alpha_context.internal_operation.operation
op)), res))
| None => None
end)
(fun function_parameter =>
let '((tt, source, nonce), (op, res)) := function_parameter in
let op :=
{|
Tezos_raw_protocol_alpha.Alpha_context.internal_operation.source :=
source;
Tezos_raw_protocol_alpha.Alpha_context.internal_operation.operation :=
(Tezos_raw_protocol_alpha.Alpha_context.Operation.Encoding.Manager_operations.case.MCase.inj
op_case) op;
Tezos_raw_protocol_alpha.Alpha_context.internal_operation.nonce :=
nonce |} in
Internal_operation_result op res) in
op_atat
(let arg := def "operation.alpha.internal_operation_result" % string in
fun eta => arg None None eta)
(union None
(cons (make Manager_result.reveal_case)
(cons (make Manager_result.transaction_case)
(cons (make Manager_result.origination_case)
(cons (make Manager_result.delegation_case) []))))).
Reserved Notation "'contents_result".
Inductive contents_result_gadt : Set :=
| Endorsement_result :
Tezos_raw_protocol_alpha.Alpha_context.Delegate.balance_updates ->
Tezos_protocol_environment_alpha__Environment.Signature.Public_key_hash.t ->
list Z -> contents_result_gadt
| Seed_nonce_revelation_result :
Tezos_raw_protocol_alpha.Alpha_context.Delegate.balance_updates ->
contents_result_gadt
| Double_endorsement_evidence_result :
Tezos_raw_protocol_alpha.Alpha_context.Delegate.balance_updates ->
contents_result_gadt
| Double_baking_evidence_result :
Tezos_raw_protocol_alpha.Alpha_context.Delegate.balance_updates ->
contents_result_gadt
| Activate_account_result :
Tezos_raw_protocol_alpha.Alpha_context.Delegate.balance_updates ->
contents_result_gadt
| Proposals_result : contents_result_gadt
| Ballot_result : contents_result_gadt
| Manager_operation_result : forall {kind : Set},
Tezos_raw_protocol_alpha.Alpha_context.Delegate.balance_updates ->
manager_operation_result kind -> list packed_internal_operation_result ->
contents_result_gadt
where "'contents_result" := (fun (kind : Set) => contents_result_gadt).
Definition contents_result := 'contents_result.
Reserved Notation "'packed_contents_result".
Inductive packed_contents_result_gadt : Set :=
| Contents_result : forall {kind : Set},
contents_result kind -> packed_contents_result_gadt
where "'packed_contents_result" := (packed_contents_result_gadt).
Definition packed_contents_result := 'packed_contents_result.
Reserved Notation "'packed_contents_and_result".
Inductive packed_contents_and_result_gadt : Set :=
| Contents_and_result : forall {kind : Set},
Tezos_raw_protocol_alpha.Alpha_context.Operation.contents kind ->
contents_result kind -> packed_contents_and_result_gadt
where "'packed_contents_and_result" := (packed_contents_and_result_gadt).
Definition packed_contents_and_result := 'packed_contents_and_result.
Reserved Notation "'eq".
Inductive eq_gadt : Set :=
| Eq : eq_gadt
where "'eq" := (fun (a b : Set) => eq_gadt).
Definition eq := 'eq.
Definition equal_manager_kind {a b : Set}
(ka : Tezos_raw_protocol_alpha.Alpha_context.Kind.manager a)
(kb : Tezos_raw_protocol_alpha.Alpha_context.Kind.manager b)
: option (eq a b) :=
match (ka, kb) with
|
(Tezos_raw_protocol_alpha.Alpha_context.Kind.Reveal_manager_kind,
Tezos_raw_protocol_alpha.Alpha_context.Kind.Reveal_manager_kind) =>
Some Eq
| (Tezos_raw_protocol_alpha.Alpha_context.Kind.Reveal_manager_kind, _) => None
|
(Tezos_raw_protocol_alpha.Alpha_context.Kind.Transaction_manager_kind,
Tezos_raw_protocol_alpha.Alpha_context.Kind.Transaction_manager_kind) =>
Some Eq
| (Tezos_raw_protocol_alpha.Alpha_context.Kind.Transaction_manager_kind, _) =>
None
|
(Tezos_raw_protocol_alpha.Alpha_context.Kind.Origination_manager_kind,
Tezos_raw_protocol_alpha.Alpha_context.Kind.Origination_manager_kind) =>
Some Eq
| (Tezos_raw_protocol_alpha.Alpha_context.Kind.Origination_manager_kind, _) =>
None
|
(Tezos_raw_protocol_alpha.Alpha_context.Kind.Delegation_manager_kind,
Tezos_raw_protocol_alpha.Alpha_context.Kind.Delegation_manager_kind) =>
Some Eq
| (Tezos_raw_protocol_alpha.Alpha_context.Kind.Delegation_manager_kind, _) =>
None
end.
Module Encoding.
Reserved Notation "'case".
Inductive case_gadt : Set :=
| Case : forall {a kind : Set},
Tezos_raw_protocol_alpha.Alpha_context.Operation.Encoding.case kind ->
Tezos_protocol_environment_alpha__Environment.Data_encoding.t a ->
(packed_contents_result -> option (contents_result kind)) ->
(packed_contents_and_result ->
option
(Tezos_raw_protocol_alpha.Alpha_context.contents kind *
contents_result kind)) -> (contents_result kind -> a) ->
(a -> contents_result kind) -> case_gadt
where "'case" := (fun (kind : Set) => case_gadt).
Definition case := 'case.
Definition tagged_case {A B : Set}
(tag : Tezos_protocol_environment_alpha__Environment.Data_encoding.case_tag)
(name : string)
(args :
Tezos_protocol_environment_alpha__Environment.Data_encoding.encoding A)
(proj : B -> option A) (inj : A -> B)
: Tezos_protocol_environment_alpha__Environment.Data_encoding.case B :=
__case_value (String.capitalize_ascii name) None tag
(merge_objs (obj1 (req None None "kind" % string (constant name))) args)
(fun x =>
match proj x with
| None => None
| Some x => Some (tt, x)
end)
(fun function_parameter =>
let '(tt, x) := function_parameter in
inj x).
Definition endorsement_case
: case Tezos_raw_protocol_alpha.Alpha_context.Kind.endorsement :=
Case
{| case.Case.op_case := Operation.Encoding.endorsement_case;
case.Case.encoding :=
obj3
(req None None "balance_updates" % string
Delegate.balance_updates_encoding)
(req None None "delegate" % string
Signature.Public_key_hash.encoding)
(req None None "slots" % string (__list_value None uint8));
case.Case.select :=
fun function_parameter =>
match function_parameter with
| Contents_result ((Endorsement_result _) as op) => Some op
| _ => None
end;
case.Case.mselect :=
fun function_parameter =>
match function_parameter with
|
Contents_and_result
((Tezos_raw_protocol_alpha.Alpha_context.Endorsement _) as op)
res => Some (op, res)
| _ => None
end;
case.Case.proj :=
fun function_parameter =>
let
'Endorsement_result {|
contents_result.Endorsement_result.balance_updates := balance_updates;
contents_result.Endorsement_result.delegate := delegate;
contents_result.Endorsement_result.slots := slots
|} := function_parameter in
(balance_updates, delegate, slots);
case.Case.inj :=
fun function_parameter =>
let '(balance_updates, delegate, slots) := function_parameter in
Endorsement_result
{|
contents_result.Endorsement_result.balance_updates :=
balance_updates;
contents_result.Endorsement_result.delegate := delegate;
contents_result.Endorsement_result.slots := slots |} |}.
Definition seed_nonce_revelation_case
: case Tezos_raw_protocol_alpha.Alpha_context.Kind.seed_nonce_revelation :=
Case
{| case.Case.op_case := Operation.Encoding.seed_nonce_revelation_case;
case.Case.encoding :=
obj1
(req None None "balance_updates" % string
Delegate.balance_updates_encoding);
case.Case.select :=
fun function_parameter =>
match function_parameter with
| Contents_result ((Seed_nonce_revelation_result _) as op) =>
Some op
| _ => None
end;
case.Case.mselect :=
fun function_parameter =>
match function_parameter with
|
Contents_and_result
((Tezos_raw_protocol_alpha.Alpha_context.Seed_nonce_revelation _)
as op) res => Some (op, res)
| _ => None
end;
case.Case.proj :=
fun function_parameter =>
let 'Seed_nonce_revelation_result bus := function_parameter in
bus; case.Case.inj := fun bus => Seed_nonce_revelation_result bus |}.
Definition double_endorsement_evidence_case
: case
Tezos_raw_protocol_alpha.Alpha_context.Kind.double_endorsement_evidence :=
Case
{|
case.Case.op_case := Operation.Encoding.double_endorsement_evidence_case;
case.Case.encoding :=
obj1
(req None None "balance_updates" % string
Delegate.balance_updates_encoding);
case.Case.select :=
fun function_parameter =>
match function_parameter with
| Contents_result ((Double_endorsement_evidence_result _) as op) =>
Some op
| _ => None
end;
case.Case.mselect :=
fun function_parameter =>
match function_parameter with
|
Contents_and_result
((Tezos_raw_protocol_alpha.Alpha_context.Double_endorsement_evidence
_) as op) res => Some (op, res)
| _ => None
end;
case.Case.proj :=
fun function_parameter =>
let 'Double_endorsement_evidence_result bus := function_parameter in
bus;
case.Case.inj := fun bus => Double_endorsement_evidence_result bus |}.
Definition double_baking_evidence_case
: case Tezos_raw_protocol_alpha.Alpha_context.Kind.double_baking_evidence :=
Case
{| case.Case.op_case := Operation.Encoding.double_baking_evidence_case;
case.Case.encoding :=
obj1
(req None None "balance_updates" % string
Delegate.balance_updates_encoding);
case.Case.select :=
fun function_parameter =>
match function_parameter with
| Contents_result ((Double_baking_evidence_result _) as op) =>
Some op
| _ => None
end;
case.Case.mselect :=
fun function_parameter =>
match function_parameter with
|
Contents_and_result
((Tezos_raw_protocol_alpha.Alpha_context.Double_baking_evidence
_) as op) res => Some (op, res)
| _ => None
end;
case.Case.proj :=
fun function_parameter =>
let 'Double_baking_evidence_result bus := function_parameter in
bus; case.Case.inj := fun bus => Double_baking_evidence_result bus
|}.
Definition activate_account_case
: case Tezos_raw_protocol_alpha.Alpha_context.Kind.activate_account :=
Case
{| case.Case.op_case := Operation.Encoding.activate_account_case;
case.Case.encoding :=
obj1
(req None None "balance_updates" % string
Delegate.balance_updates_encoding);
case.Case.select :=
fun function_parameter =>
match function_parameter with
| Contents_result ((Activate_account_result _) as op) => Some op
| _ => None
end;
case.Case.mselect :=
fun function_parameter =>
match function_parameter with
|
Contents_and_result
((Tezos_raw_protocol_alpha.Alpha_context.Activate_account _) as
op) res => Some (op, res)
| _ => None
end;
case.Case.proj :=
fun function_parameter =>
let 'Activate_account_result bus := function_parameter in
bus; case.Case.inj := fun bus => Activate_account_result bus |}.
Definition proposals_case
: case Tezos_raw_protocol_alpha__Alpha_context.Kind.proposals :=
Case
{| case.Case.op_case := Operation.Encoding.proposals_case;
case.Case.encoding := Data_encoding.empty;
case.Case.select :=
fun function_parameter =>
match function_parameter with
| Contents_result (Proposals_result as op) => Some op
| _ => None
end;
case.Case.mselect :=
fun function_parameter =>
match function_parameter with
|
Contents_and_result
((Tezos_raw_protocol_alpha.Alpha_context.Proposals _) as op) res
=> Some (op, res)
| _ => None
end;
case.Case.proj :=
fun function_parameter =>
let 'Proposals_result := function_parameter in
tt;
case.Case.inj :=
fun function_parameter =>
let 'tt := function_parameter in
Proposals_result |}.
Definition ballot_case
: case Tezos_raw_protocol_alpha__Alpha_context.Kind.ballot :=
Case
{| case.Case.op_case := Operation.Encoding.ballot_case;
case.Case.encoding := Data_encoding.empty;
case.Case.select :=
fun function_parameter =>
match function_parameter with
| Contents_result (Ballot_result as op) => Some op
| _ => None
end;
case.Case.mselect :=
fun function_parameter =>
match function_parameter with
|
Contents_and_result
((Tezos_raw_protocol_alpha.Alpha_context.Ballot _) as op) res =>
Some (op, res)
| _ => None
end;
case.Case.proj :=
fun function_parameter =>
let 'Ballot_result := function_parameter in
tt;
case.Case.inj :=
fun function_parameter =>
let 'tt := function_parameter in
Ballot_result |}.
Definition make_manager_case {A : Set}
(function_parameter :
Tezos_raw_protocol_alpha.Alpha_context.Operation.Encoding.case
(Tezos_raw_protocol_alpha.Alpha_context.Kind.manager A))
: Manager_result.case A ->
(packed_contents_and_result ->
option
(Tezos_raw_protocol_alpha.Alpha_context.contents
(Tezos_raw_protocol_alpha.Alpha_context.Kind.manager A) *
contents_result (Tezos_raw_protocol_alpha.Alpha_context.Kind.manager A)))
-> case (Tezos_raw_protocol_alpha.Alpha_context.Kind.manager A) :=
let
'Tezos_raw_protocol_alpha.Alpha_context.Operation.Encoding.Case op_case :=
function_parameter in
fun function_parameter =>
let 'Manager_result.MCase res_case := function_parameter in
fun mselect =>
Case
{|
case.Case.op_case :=
Tezos_raw_protocol_alpha.Alpha_context.Operation.Encoding.Case
op_case;
case.Case.encoding :=
obj3
(req None None "balance_updates" % string
Delegate.balance_updates_encoding)
(req None None "operation_result" % string
(Manager_result.case.MCase.t res_case))
(dft None None "internal_operation_results" % string
(__list_value None internal_operation_result_encoding) []);
case.Case.select :=
fun function_parameter =>
match function_parameter with
|
Contents_result
(Manager_operation_result
({|
contents_result.Manager_operation_result.operation_result := Applied res
|} as op)) =>
match
(Manager_result.case.MCase.select res_case)
(Successful_manager_result res) with
| Some res =>
Some
(Manager_operation_result
(* ❌ Record substitution not handled *)
record_substitution)
| None => None
end
|
Contents_result
(Manager_operation_result
({|
contents_result.Manager_operation_result.operation_result :=
Backtracked res errs
|} as op)) =>
match
(Manager_result.case.MCase.select res_case)
(Successful_manager_result res) with
| Some res =>
Some
(Manager_operation_result
(* ❌ Record substitution not handled *)
record_substitution)
| None => None
end
|
Contents_result
(Manager_operation_result
({|
contents_result.Manager_operation_result.operation_result := Skipped kind
|} as op)) =>
match
equal_manager_kind kind
(Manager_result.case.MCase.kind res_case) with
| None => None
| Some Eq =>
Some
(Manager_operation_result
(* ❌ Record substitution not handled *)
record_substitution)
end
|
Contents_result
(Manager_operation_result
({|
contents_result.Manager_operation_result.operation_result := Failed kind errs
|} as op)) =>
match
equal_manager_kind kind
(Manager_result.case.MCase.kind res_case) with
| None => None
| Some Eq =>
Some
(Manager_operation_result
(* ❌ Record substitution not handled *)
record_substitution)
end
| Contents_result Ballot_result => None
| Contents_result (Endorsement_result _) => None
| Contents_result (Seed_nonce_revelation_result _) => None
| Contents_result (Double_endorsement_evidence_result _) => None
| Contents_result (Double_baking_evidence_result _) => None
| Contents_result (Activate_account_result _) => None
| Contents_result Proposals_result => None
end; case.Case.mselect := mselect;
case.Case.proj :=
fun function_parameter =>
let
'Manager_operation_result {|
contents_result.Manager_operation_result.balance_updates := bus;
contents_result.Manager_operation_result.operation_result
:= r;
contents_result.Manager_operation_result.internal_operation_results
:= rs
|} := function_parameter in
(bus, r, rs);
case.Case.inj :=
fun function_parameter =>
let '(bus, r, rs) := function_parameter in
Manager_operation_result
{|
contents_result.Manager_operation_result.balance_updates :=
bus;
contents_result.Manager_operation_result.operation_result :=
r;
contents_result.Manager_operation_result.internal_operation_results :=
rs |} |}.
Definition reveal_case
: case
(Tezos_raw_protocol_alpha.Alpha_context.Kind.manager
Tezos_raw_protocol_alpha.Alpha_context.Kind.reveal) :=
make_manager_case Operation.Encoding.reveal_case Manager_result.reveal_case
(fun function_parameter =>
match function_parameter with
|
Contents_and_result
((Tezos_raw_protocol_alpha.Alpha_context.Manager_operation {|
Tezos_raw_protocol_alpha.Alpha_context.contents.Manager_operation.operation :=
Tezos_raw_protocol_alpha.Alpha_context.Reveal _
|}) as op) res => Some (op, res)
| _ => None
end).
Definition transaction_case
: case
(Tezos_raw_protocol_alpha.Alpha_context.Kind.manager
Tezos_raw_protocol_alpha.Alpha_context.Kind.transaction) :=
make_manager_case Operation.Encoding.transaction_case
Manager_result.transaction_case
(fun function_parameter =>
match function_parameter with
|
Contents_and_result
((Tezos_raw_protocol_alpha.Alpha_context.Manager_operation {|
Tezos_raw_protocol_alpha.Alpha_context.contents.Manager_operation.operation :=
Tezos_raw_protocol_alpha.Alpha_context.Transaction _
|}) as op) res => Some (op, res)
| _ => None
end).
Definition origination_case
: case
(Tezos_raw_protocol_alpha.Alpha_context.Kind.manager
Tezos_raw_protocol_alpha.Alpha_context.Kind.origination) :=
make_manager_case Operation.Encoding.origination_case
Manager_result.origination_case
(fun function_parameter =>
match function_parameter with
|
Contents_and_result
((Tezos_raw_protocol_alpha.Alpha_context.Manager_operation {|
Tezos_raw_protocol_alpha.Alpha_context.contents.Manager_operation.operation :=
Tezos_raw_protocol_alpha.Alpha_context.Origination _
|}) as op) res => Some (op, res)
| _ => None
end).
Definition delegation_case
: case
(Tezos_raw_protocol_alpha.Alpha_context.Kind.manager
Tezos_raw_protocol_alpha.Alpha_context.Kind.delegation) :=
make_manager_case Operation.Encoding.delegation_case
Manager_result.delegation_case
(fun function_parameter =>
match function_parameter with
|
Contents_and_result
((Tezos_raw_protocol_alpha.Alpha_context.Manager_operation {|
Tezos_raw_protocol_alpha.Alpha_context.contents.Manager_operation.operation :=
Tezos_raw_protocol_alpha.Alpha_context.Delegation _
|}) as op) res => Some (op, res)
| _ => None
end).
End Encoding.
Definition contents_result_encoding
: Tezos_protocol_environment_alpha__Environment.Data_encoding.encoding
packed_contents_result :=
let make {A : Set} (function_parameter : Encoding.case A)
: Tezos_protocol_environment_alpha__Environment.Data_encoding.case
packed_contents_result :=
let
'Encoding.Case {|
Encoding.case.Case.op_case :=
Tezos_raw_protocol_alpha.Alpha_context.Operation.Encoding.Case {|
Tezos_raw_protocol_alpha.Alpha_context.Operation.Encoding.case.Case.tag
:= tag;
Tezos_raw_protocol_alpha.Alpha_context.Operation.Encoding.case.Case.name
:= name
|};
Encoding.case.Case.encoding := encoding;
Encoding.case.Case.select := select;
Encoding.case.Case.mselect := _;
Encoding.case.Case.proj := proj;
Encoding.case.Case.inj := inj
|} := function_parameter in
let proj (x : packed_contents_result) : option op_dollarCase_'a :=
match select x with
| None => None
| Some x => Some (proj x)
end in
let inj (x : op_dollarCase_'a) : packed_contents_result :=
Contents_result (inj x) in
tagged_case
(Tezos_protocol_environment_alpha__Environment.Data_encoding.Tag tag) name
encoding proj inj in
op_atat
(let arg := def "operation.alpha.contents_result" % string in
fun eta => arg None None eta)
(union None
(cons (make endorsement_case)
(cons (make seed_nonce_revelation_case)
(cons (make double_endorsement_evidence_case)
(cons (make double_baking_evidence_case)
(cons (make activate_account_case)
(cons (make proposals_case)
(cons (make ballot_case)
(cons (make reveal_case)
(cons (make transaction_case)
(cons (make origination_case)
(cons (make delegation_case) [])))))))))))).
Definition contents_and_result_encoding
: Tezos_protocol_environment_alpha__Environment.Data_encoding.encoding
packed_contents_and_result :=
let make {A : Set} (function_parameter : Encoding.case A)
: Tezos_protocol_environment_alpha__Environment.Data_encoding.case
packed_contents_and_result :=
let
'Encoding.Case {|
Encoding.case.Case.op_case :=
Tezos_raw_protocol_alpha.Alpha_context.Operation.Encoding.Case {|
Tezos_raw_protocol_alpha.Alpha_context.Operation.Encoding.case.Case.tag
:= tag;
Tezos_raw_protocol_alpha.Alpha_context.Operation.Encoding.case.Case.name
:= name;
Tezos_raw_protocol_alpha.Alpha_context.Operation.Encoding.case.Case.encoding
:= encoding;
Tezos_raw_protocol_alpha.Alpha_context.Operation.Encoding.case.Case.proj
:= proj;
Tezos_raw_protocol_alpha.Alpha_context.Operation.Encoding.case.Case.inj
:= inj
|};
Encoding.case.Case.encoding := meta_encoding;
Encoding.case.Case.mselect := mselect;
Encoding.case.Case.proj := meta_proj;
Encoding.case.Case.inj := meta_inj
|} := function_parameter in
let proj (c : packed_contents_and_result)
: option (op_dollarCase_'a1 * op_dollarCase_'a) :=
match mselect c with
| Some (op, res) => Some ((proj op), (meta_proj res))
| _ => None
end in
let inj (function_parameter : op_dollarCase_'a1 * op_dollarCase_'a)
: packed_contents_and_result :=
let '(op, res) := function_parameter in
Contents_and_result (inj op) (meta_inj res) in
let encoding :=
merge_objs encoding
(obj1 (req None None "metadata" % string meta_encoding)) in
tagged_case
(Tezos_protocol_environment_alpha__Environment.Data_encoding.Tag tag) name
encoding proj inj in
op_atat
(let arg := def "operation.alpha.operation_contents_and_result" % string in
fun eta => arg None None eta)
(union None
(cons (make endorsement_case)
(cons (make seed_nonce_revelation_case)
(cons (make double_endorsement_evidence_case)
(cons (make double_baking_evidence_case)
(cons (make activate_account_case)
(cons (make proposals_case)
(cons (make ballot_case)
(cons (make reveal_case)
(cons (make transaction_case)
(cons (make origination_case)
(cons (make delegation_case) [])))))))))))).
Reserved Notation "'contents_result_list".
Inductive contents_result_list_gadt : Set :=
| Single_result : forall {kind : Set},
contents_result kind -> contents_result_list_gadt
| Cons_result : forall {kind : Set},
contents_result (Tezos_raw_protocol_alpha.Alpha_context.Kind.manager kind) ->
contents_result_list_gadt -> contents_result_list_gadt
where "'contents_result_list" := (fun (kind : Set) => contents_result_list_gadt).
Definition contents_result_list := 'contents_result_list.
Reserved Notation "'packed_contents_result_list".
Inductive packed_contents_result_list_gadt : Set :=
| Contents_result_list : forall {kind : Set},
contents_result_list kind -> packed_contents_result_list_gadt
where "'packed_contents_result_list" := (packed_contents_result_list_gadt).
Definition packed_contents_result_list := 'packed_contents_result_list.
Definition contents_result_list_encoding
: Tezos_protocol_environment_alpha__Environment.Data_encoding.encoding
packed_contents_result_list :=
let fix to_list (function_parameter : packed_contents_result_list)
: list packed_contents_result :=
match function_parameter with
| Contents_result_list (Single_result o) => cons (Contents_result o) []
| Contents_result_list (Cons_result o os) =>
cons (Contents_result o) (to_list (Contents_result_list os))
end in
let fix of_list (function_parameter : list packed_contents_result)
: packed_contents_result_list :=
match function_parameter with
| [] => Pervasives.failwith "cannot decode empty operation result" % string
| cons (Contents_result o) [] => Contents_result_list (Single_result o)
| cons (Contents_result o) os =>
let 'Contents_result_list os := of_list os in
match (o, os) with
| (Manager_operation_result _, Single_result (Manager_operation_result _))
=> Contents_result_list (Cons_result o os)
| (Manager_operation_result _, Cons_result _ _) =>
Contents_result_list (Cons_result o os)
| _ =>
Pervasives.failwith "cannot decode ill-formed operation result" % string
end
end in
op_atat
(let arg := def "operation.alpha.contents_list_result" % string in
fun eta => arg None None eta)
(conv to_list of_list None (__list_value None contents_result_encoding)).
Reserved Notation "'contents_and_result_list".
Inductive contents_and_result_list_gadt : Set :=
| Single_and_result : forall {kind : Set},
Tezos_raw_protocol_alpha.Alpha_context.contents kind ->
contents_result kind -> contents_and_result_list_gadt
| Cons_and_result : forall {kind : Set},
Tezos_raw_protocol_alpha.Alpha_context.contents
(Tezos_raw_protocol_alpha.Alpha_context.Kind.manager kind) ->
contents_result (Tezos_raw_protocol_alpha.Alpha_context.Kind.manager kind) ->
contents_and_result_list_gadt -> contents_and_result_list_gadt
where "'contents_and_result_list" := (fun (kind : Set) =>
contents_and_result_list_gadt).
Definition contents_and_result_list := 'contents_and_result_list.
Reserved Notation "'packed_contents_and_result_list".
Inductive packed_contents_and_result_list_gadt : Set :=
| Contents_and_result_list : forall {kind : Set},
contents_and_result_list kind -> packed_contents_and_result_list_gadt
where "'packed_contents_and_result_list" :=
(packed_contents_and_result_list_gadt).
Definition packed_contents_and_result_list := 'packed_contents_and_result_list.
Definition contents_and_result_list_encoding
: Tezos_protocol_environment_alpha__Environment.Data_encoding.encoding
packed_contents_and_result_list :=
let fix to_list (function_parameter : packed_contents_and_result_list)
: list packed_contents_and_result :=
match function_parameter with
| Contents_and_result_list (Single_and_result op res) =>
cons (Contents_and_result op res) []
| Contents_and_result_list (Cons_and_result op res rest) =>
cons (Contents_and_result op res)
(to_list (Contents_and_result_list rest))
end in
let fix of_list (function_parameter : list packed_contents_and_result)
: packed_contents_and_result_list :=
match function_parameter with
| [] =>
Pervasives.failwith
"cannot decode empty combined operation result" % string
| cons (Contents_and_result op res) [] =>
Contents_and_result_list (Single_and_result op res)
| cons (Contents_and_result op res) rest =>
let 'Contents_and_result_list rest := of_list rest in
match (op, rest) with
|
(Tezos_raw_protocol_alpha.Alpha_context.Manager_operation _,
Single_and_result
(Tezos_raw_protocol_alpha.Alpha_context.Manager_operation _) _) =>
Contents_and_result_list (Cons_and_result op res rest)
|
(Tezos_raw_protocol_alpha.Alpha_context.Manager_operation _,
Cons_and_result _ _ _) =>
Contents_and_result_list (Cons_and_result op res rest)
| _ =>
Pervasives.failwith
"cannot decode ill-formed combined operation result" % string
end
end in
conv to_list of_list None
(__Variable.__list_value None contents_and_result_encoding).
Module operation_metadata.
Record record {kind : Set} := {
contents : contents_result_list kind }.
Arguments record : clear implicits.
End operation_metadata.
Definition operation_metadata := operation_metadata.record.
Reserved Notation "'packed_operation_metadata".
Inductive packed_operation_metadata_gadt : Set :=
| Operation_metadata : forall {kind : Set},
operation_metadata kind -> packed_operation_metadata_gadt
| No_operation_metadata : packed_operation_metadata_gadt
where "'packed_operation_metadata" := (packed_operation_metadata_gadt).
Definition packed_operation_metadata := 'packed_operation_metadata.
Definition operation_metadata_encoding
: Tezos_protocol_environment_alpha__Environment.Data_encoding.encoding
packed_operation_metadata :=
op_atat
(let arg := def "operation.alpha.result" % string in
fun eta => arg None None eta)
(union None
(cons
(__case_value "Operation_metadata" % string None
(Tezos_protocol_environment_alpha__Environment.Data_encoding.Tag 0)
contents_result_list_encoding
(fun function_parameter =>
match function_parameter with
| Operation_metadata {| operation_metadata.contents := contents |}
=> Some (Contents_result_list contents)
| _ => None
end)
(fun function_parameter =>
let 'Contents_result_list contents := function_parameter in
Operation_metadata {| operation_metadata.contents := contents |}))
(cons
(__case_value "No_operation_metadata" % string None
(Tezos_protocol_environment_alpha__Environment.Data_encoding.Tag 1)
empty
(fun function_parameter =>
match function_parameter with
| No_operation_metadata => Some tt
| _ => None
end)
(fun function_parameter =>
let 'tt := function_parameter in
No_operation_metadata)) []))).
Definition kind_equal {kind kind2 : Set}
(op : Tezos_raw_protocol_alpha.Alpha_context.contents kind)
(res : contents_result kind2) : option (eq kind kind2) :=
match (op, res) with
| (Tezos_raw_protocol_alpha.Alpha_context.Endorsement _, Endorsement_result _)
=> Some Eq
| (Tezos_raw_protocol_alpha.Alpha_context.Endorsement _, _) => None
|
(Tezos_raw_protocol_alpha.Alpha_context.Seed_nonce_revelation _,
Seed_nonce_revelation_result _) => Some Eq
| (Tezos_raw_protocol_alpha.Alpha_context.Seed_nonce_revelation _, _) => None
|
(Tezos_raw_protocol_alpha.Alpha_context.Double_endorsement_evidence _,
Double_endorsement_evidence_result _) => Some Eq
| (Tezos_raw_protocol_alpha.Alpha_context.Double_endorsement_evidence _, _) =>
None
|
(Tezos_raw_protocol_alpha.Alpha_context.Double_baking_evidence _,
Double_baking_evidence_result _) => Some Eq
| (Tezos_raw_protocol_alpha.Alpha_context.Double_baking_evidence _, _) => None
|
(Tezos_raw_protocol_alpha.Alpha_context.Activate_account _,
Activate_account_result _) => Some Eq
| (Tezos_raw_protocol_alpha.Alpha_context.Activate_account _, _) => None
| (Tezos_raw_protocol_alpha.Alpha_context.Proposals _, Proposals_result) =>
Some Eq
| (Tezos_raw_protocol_alpha.Alpha_context.Proposals _, _) => None
| (Tezos_raw_protocol_alpha.Alpha_context.Ballot _, Ballot_result) => Some Eq
| (Tezos_raw_protocol_alpha.Alpha_context.Ballot _, _) => None
|
(Tezos_raw_protocol_alpha.Alpha_context.Manager_operation {|
Tezos_raw_protocol_alpha.Alpha_context.contents.Manager_operation.operation :=
Tezos_raw_protocol_alpha.Alpha_context.Reveal _
|},
Manager_operation_result {|
contents_result.Manager_operation_result.operation_result :=
Applied (Reveal_result _)
|}) => Some Eq
|
(Tezos_raw_protocol_alpha.Alpha_context.Manager_operation {|
Tezos_raw_protocol_alpha.Alpha_context.contents.Manager_operation.operation :=
Tezos_raw_protocol_alpha.Alpha_context.Reveal _
|},
Manager_operation_result {|
contents_result.Manager_operation_result.operation_result :=
Backtracked (Reveal_result _) _
|}) => Some Eq
|
(Tezos_raw_protocol_alpha.Alpha_context.Manager_operation {|
Tezos_raw_protocol_alpha.Alpha_context.contents.Manager_operation.operation :=
Tezos_raw_protocol_alpha.Alpha_context.Reveal _
|},
Manager_operation_result {|
contents_result.Manager_operation_result.operation_result :=
Failed Tezos_raw_protocol_alpha.Alpha_context.Kind.Reveal_manager_kind
_
|}) => Some Eq
|
(Tezos_raw_protocol_alpha.Alpha_context.Manager_operation {|
Tezos_raw_protocol_alpha.Alpha_context.contents.Manager_operation.operation :=
Tezos_raw_protocol_alpha.Alpha_context.Reveal _
|},
Manager_operation_result {|
contents_result.Manager_operation_result.operation_result :=
Skipped
Tezos_raw_protocol_alpha.Alpha_context.Kind.Reveal_manager_kind
|}) => Some Eq
|
(Tezos_raw_protocol_alpha.Alpha_context.Manager_operation {|
Tezos_raw_protocol_alpha.Alpha_context.contents.Manager_operation.operation :=
Tezos_raw_protocol_alpha.Alpha_context.Reveal _
|}, _) => None
|
(Tezos_raw_protocol_alpha.Alpha_context.Manager_operation {|
Tezos_raw_protocol_alpha.Alpha_context.contents.Manager_operation.operation :=
Tezos_raw_protocol_alpha.Alpha_context.Transaction _
|},
Manager_operation_result {|
contents_result.Manager_operation_result.operation_result :=
Applied (Transaction_result _)
|}) => Some Eq
|
(Tezos_raw_protocol_alpha.Alpha_context.Manager_operation {|
Tezos_raw_protocol_alpha.Alpha_context.contents.Manager_operation.operation :=
Tezos_raw_protocol_alpha.Alpha_context.Transaction _
|},
Manager_operation_result {|
contents_result.Manager_operation_result.operation_result :=
Backtracked (Transaction_result _) _
|}) => Some Eq
|
(Tezos_raw_protocol_alpha.Alpha_context.Manager_operation {|
Tezos_raw_protocol_alpha.Alpha_context.contents.Manager_operation.operation :=
Tezos_raw_protocol_alpha.Alpha_context.Transaction _
|},
Manager_operation_result {|
contents_result.Manager_operation_result.operation_result :=
Failed
Tezos_raw_protocol_alpha.Alpha_context.Kind.Transaction_manager_kind
_
|}) => Some Eq
|
(Tezos_raw_protocol_alpha.Alpha_context.Manager_operation {|
Tezos_raw_protocol_alpha.Alpha_context.contents.Manager_operation.operation :=
Tezos_raw_protocol_alpha.Alpha_context.Transaction _
|},
Manager_operation_result {|
contents_result.Manager_operation_result.operation_result :=
Skipped
Tezos_raw_protocol_alpha.Alpha_context.Kind.Transaction_manager_kind
|}) => Some Eq
|
(Tezos_raw_protocol_alpha.Alpha_context.Manager_operation {|
Tezos_raw_protocol_alpha.Alpha_context.contents.Manager_operation.operation :=
Tezos_raw_protocol_alpha.Alpha_context.Transaction _
|}, _) => None
|
(Tezos_raw_protocol_alpha.Alpha_context.Manager_operation {|
Tezos_raw_protocol_alpha.Alpha_context.contents.Manager_operation.operation :=
Tezos_raw_protocol_alpha.Alpha_context.Origination _
|},
Manager_operation_result {|
contents_result.Manager_operation_result.operation_result :=
Applied (Origination_result _)
|}) => Some Eq
|
(Tezos_raw_protocol_alpha.Alpha_context.Manager_operation {|
Tezos_raw_protocol_alpha.Alpha_context.contents.Manager_operation.operation :=
Tezos_raw_protocol_alpha.Alpha_context.Origination _
|},
Manager_operation_result {|
contents_result.Manager_operation_result.operation_result :=
Backtracked (Origination_result _) _
|}) => Some Eq
|
(Tezos_raw_protocol_alpha.Alpha_context.Manager_operation {|
Tezos_raw_protocol_alpha.Alpha_context.contents.Manager_operation.operation :=
Tezos_raw_protocol_alpha.Alpha_context.Origination _
|},
Manager_operation_result {|
contents_result.Manager_operation_result.operation_result :=
Failed
Tezos_raw_protocol_alpha.Alpha_context.Kind.Origination_manager_kind
_
|}) => Some Eq
|
(Tezos_raw_protocol_alpha.Alpha_context.Manager_operation {|
Tezos_raw_protocol_alpha.Alpha_context.contents.Manager_operation.operation :=
Tezos_raw_protocol_alpha.Alpha_context.Origination _
|},
Manager_operation_result {|
contents_result.Manager_operation_result.operation_result :=
Skipped
Tezos_raw_protocol_alpha.Alpha_context.Kind.Origination_manager_kind
|}) => Some Eq
|
(Tezos_raw_protocol_alpha.Alpha_context.Manager_operation {|
Tezos_raw_protocol_alpha.Alpha_context.contents.Manager_operation.operation :=
Tezos_raw_protocol_alpha.Alpha_context.Origination _
|}, _) => None
|
(Tezos_raw_protocol_alpha.Alpha_context.Manager_operation {|
Tezos_raw_protocol_alpha.Alpha_context.contents.Manager_operation.operation :=
Tezos_raw_protocol_alpha.Alpha_context.Delegation _
|},
Manager_operation_result {|
contents_result.Manager_operation_result.operation_result :=
Applied (Delegation_result _)
|}) => Some Eq
|
(Tezos_raw_protocol_alpha.Alpha_context.Manager_operation {|
Tezos_raw_protocol_alpha.Alpha_context.contents.Manager_operation.operation :=
Tezos_raw_protocol_alpha.Alpha_context.Delegation _
|},
Manager_operation_result {|
contents_result.Manager_operation_result.operation_result :=
Backtracked (Delegation_result _) _
|}) => Some Eq
|
(Tezos_raw_protocol_alpha.Alpha_context.Manager_operation {|
Tezos_raw_protocol_alpha.Alpha_context.contents.Manager_operation.operation :=
Tezos_raw_protocol_alpha.Alpha_context.Delegation _
|},
Manager_operation_result {|
contents_result.Manager_operation_result.operation_result :=
Failed
Tezos_raw_protocol_alpha.Alpha_context.Kind.Delegation_manager_kind
_
|}) => Some Eq
|
(Tezos_raw_protocol_alpha.Alpha_context.Manager_operation {|
Tezos_raw_protocol_alpha.Alpha_context.contents.Manager_operation.operation :=
Tezos_raw_protocol_alpha.Alpha_context.Delegation _
|},
Manager_operation_result {|
contents_result.Manager_operation_result.operation_result :=
Skipped
Tezos_raw_protocol_alpha.Alpha_context.Kind.Delegation_manager_kind
|}) => Some Eq
|
(Tezos_raw_protocol_alpha.Alpha_context.Manager_operation {|
Tezos_raw_protocol_alpha.Alpha_context.contents.Manager_operation.operation :=
Tezos_raw_protocol_alpha.Alpha_context.Delegation _
|}, _) => None
end.
Fixpoint kind_equal_list {kind kind2 : Set}
(contents : Tezos_raw_protocol_alpha.Alpha_context.contents_list kind)
(res : contents_result_list kind2) : option (eq kind kind2) :=
match (contents, res) with
| (Tezos_raw_protocol_alpha.Alpha_context.Single op, Single_result res) =>
match kind_equal op res with
| None => None
| Some Eq => Some Eq
end
| (Tezos_raw_protocol_alpha.Alpha_context.Cons op ops, Cons_result res ress)
=>
match kind_equal op res with
| None => None
| Some Eq =>
match kind_equal_list ops ress with
| None => None
| Some Eq => Some Eq
end
end
| _ => None
end.
Fixpoint pack_contents_list {kind : Set}
(contents : Tezos_raw_protocol_alpha.Alpha_context.contents_list kind)
(res : contents_result_list kind) : contents_and_result_list kind :=
match (contents, res) with
| (Tezos_raw_protocol_alpha.Alpha_context.Single op, Single_result res) =>
Single_and_result op res
| (Tezos_raw_protocol_alpha.Alpha_context.Cons op ops, Cons_result res ress)
=> Cons_and_result op res (pack_contents_list ops ress)
|
(Tezos_raw_protocol_alpha.Alpha_context.Single
(Tezos_raw_protocol_alpha.Alpha_context.Manager_operation _),
Cons_result (Manager_operation_result _) (Single_result _)) =>
(* ❌ Unreachable expressions are not supported *)
unreachable
|
(Tezos_raw_protocol_alpha.Alpha_context.Cons _ _,
Single_result
(Manager_operation_result {|
contents_result.Manager_operation_result.operation_result := Failed _ _
|})) =>
(* ❌ Unreachable expressions are not supported *)
unreachable
|
(Tezos_raw_protocol_alpha.Alpha_context.Cons _ _,
Single_result
(Manager_operation_result {|
contents_result.Manager_operation_result.operation_result := Skipped _
|})) =>
(* ❌ Unreachable expressions are not supported *)
unreachable
|
(Tezos_raw_protocol_alpha.Alpha_context.Cons _ _,
Single_result
(Manager_operation_result {|
contents_result.Manager_operation_result.operation_result := Applied _
|})) =>
(* ❌ Unreachable expressions are not supported *)
unreachable
|
(Tezos_raw_protocol_alpha.Alpha_context.Cons _ _,
Single_result
(Manager_operation_result {|
contents_result.Manager_operation_result.operation_result := Backtracked _ _
|})) =>
(* ❌ Unreachable expressions are not supported *)
unreachable
| (Tezos_raw_protocol_alpha.Alpha_context.Single _, Cons_result _ _) =>
(* ❌ Unreachable expressions are not supported *)
unreachable
end.
Fixpoint unpack_contents_list {kind : Set}
(function_parameter : contents_and_result_list kind)
: Tezos_raw_protocol_alpha.Alpha_context.contents_list kind *
contents_result_list kind :=
match function_parameter with
| Single_and_result op res =>
((Tezos_raw_protocol_alpha.Alpha_context.Single op), (Single_result res))
| Cons_and_result op res rest =>
let '(ops, ress) := unpack_contents_list rest in
((Tezos_raw_protocol_alpha.Alpha_context.Cons op ops),
(Cons_result res ress))
end.
Fixpoint to_list (function_parameter : packed_contents_result_list)
: list packed_contents_result :=
match function_parameter with
| Contents_result_list (Single_result o) => cons (Contents_result o) []
| Contents_result_list (Cons_result o os) =>
cons (Contents_result o) (to_list (Contents_result_list os))
end.
Fixpoint of_list (function_parameter : list packed_contents_result)
: packed_contents_result_list :=
match function_parameter with
| [] =>
(* ❌ Assert instruction is not handled. *)
assert false
| cons (Contents_result o) [] => Contents_result_list (Single_result o)
| cons (Contents_result o) os =>
let 'Contents_result_list os := of_list os in
match (o, os) with
| (Manager_operation_result _, Single_result (Manager_operation_result _))
=> Contents_result_list (Cons_result o os)
| (Manager_operation_result _, Cons_result _ _) =>
Contents_result_list (Cons_result o os)
| _ =>
Pervasives.failwith
"Operation result list of length > 1 should only contains manager operations result."
% string
end
end.
Definition operation_data_and_metadata_encoding
: Tezos_protocol_environment_alpha__Environment.Data_encoding.encoding
(Tezos_raw_protocol_alpha.Alpha_context.packed_protocol_data *
packed_operation_metadata) :=
op_atat
(let arg := def "operation.alpha.operation_with_metadata" % string in
fun eta => arg None None eta)
(union None
(cons
(__case_value "Operation_with_metadata" % string None
(Tezos_protocol_environment_alpha__Environment.Data_encoding.Tag 0)
(obj2
(req None None "contents" % string
(dynamic_size None contents_and_result_list_encoding))
(opt None None "signature" % string Signature.encoding))
(fun function_parameter =>
match function_parameter with
|
(Tezos_raw_protocol_alpha.Alpha_context.Operation_data _,
No_operation_metadata) => None
|
(Tezos_raw_protocol_alpha.Alpha_context.Operation_data op,
Operation_metadata res) =>
match
kind_equal_list
(Tezos_raw_protocol_alpha.Alpha_context.protocol_data.contents
op) (operation_metadata.contents res) with
| None =>
Pervasives.failwith
"cannot decode inconsistent combined operation result" %
string
| Some Eq =>
Some
((Contents_and_result_list
(pack_contents_list
(Tezos_raw_protocol_alpha.Alpha_context.protocol_data.contents
op) (operation_metadata.contents res))),
(Tezos_raw_protocol_alpha.Alpha_context.protocol_data.signature
op))
end
end)
(fun function_parameter =>
let '(Contents_and_result_list contents, signature) :=
function_parameter in
let '(op_contents, res_contents) := unpack_contents_list contents in
((Tezos_raw_protocol_alpha.Alpha_context.Operation_data
{|
Tezos_raw_protocol_alpha.Alpha_context.protocol_data.contents :=
op_contents;
Tezos_raw_protocol_alpha.Alpha_context.protocol_data.signature :=
signature |}),
(Operation_metadata
{| operation_metadata.contents := res_contents |}))))
(cons
(__case_value "Operation_without_metadata" % string None
(Tezos_protocol_environment_alpha__Environment.Data_encoding.Tag 1)
(obj2
(req None None "contents" % string
(dynamic_size None Operation.contents_list_encoding))
(opt None None "signature" % string Signature.encoding))
(fun function_parameter =>
match function_parameter with
|
(Tezos_raw_protocol_alpha.Alpha_context.Operation_data op,
No_operation_metadata) =>
Some
((Tezos_raw_protocol_alpha.Alpha_context.Contents_list
(Tezos_raw_protocol_alpha.Alpha_context.protocol_data.contents
op)),
(Tezos_raw_protocol_alpha.Alpha_context.protocol_data.signature
op))
|
(Tezos_raw_protocol_alpha.Alpha_context.Operation_data _,
Operation_metadata _) => None
end)
(fun function_parameter =>
let
'(Tezos_raw_protocol_alpha.Alpha_context.Contents_list contents,
signature) := function_parameter in
((Tezos_raw_protocol_alpha.Alpha_context.Operation_data
{|
Tezos_raw_protocol_alpha.Alpha_context.protocol_data.contents :=
contents;
Tezos_raw_protocol_alpha.Alpha_context.protocol_data.signature :=
signature |}), No_operation_metadata))) []))).
Module block_metadata.
Record record := {
baker :
Tezos_protocol_environment_alpha__Environment.Signature.Public_key_hash.t;
level : Tezos_raw_protocol_alpha.Alpha_context.Level.t;
voting_period_kind :
Tezos_raw_protocol_alpha.Alpha_context.Voting_period.kind;
nonce_hash : option Tezos_raw_protocol_alpha.Nonce_hash.t;
consumed_gas : Tezos_protocol_environment_alpha__Environment.Z.t;
deactivated :
list
Tezos_protocol_environment_alpha__Environment.Signature.Public_key_hash.t;
balance_updates :
Tezos_raw_protocol_alpha.Alpha_context.Delegate.balance_updates }.
End block_metadata.
Definition block_metadata := block_metadata.record.
Definition block_metadata_encoding
: Tezos_protocol_environment_alpha__Environment.Data_encoding.encoding
block_metadata :=
op_atat
(let arg := def "block_header.alpha.metadata" % string in
fun eta => arg None None eta)
(conv
(fun function_parameter =>
let '{|
block_metadata.baker := baker;
block_metadata.level := level;
block_metadata.voting_period_kind := voting_period_kind;
block_metadata.nonce_hash := nonce_hash;
block_metadata.consumed_gas := consumed_gas;
block_metadata.deactivated := deactivated;
block_metadata.balance_updates := balance_updates
|} := function_parameter in
(baker, level, voting_period_kind, nonce_hash, consumed_gas,
deactivated, balance_updates))
(fun function_parameter =>
let
'(baker, level, voting_period_kind, nonce_hash, consumed_gas,
deactivated, balance_updates) := function_parameter in
{| block_metadata.baker := baker; block_metadata.level := level;
block_metadata.voting_period_kind := voting_period_kind;
block_metadata.nonce_hash := nonce_hash;
block_metadata.consumed_gas := consumed_gas;
block_metadata.deactivated := deactivated;
block_metadata.balance_updates := balance_updates |}) None
(obj7 (req None None "baker" % string Signature.Public_key_hash.encoding)
(req None None "level" % string Level.encoding)
(req None None "voting_period_kind" % string Voting_period.kind_encoding)
(req None None "nonce_hash" % string
(__option_value Nonce_hash.encoding))
(req None None "consumed_gas" % string (check_size 10 n))
(req None None "deactivated" % string
(__list_value None Signature.Public_key_hash.encoding))
(req None None "balance_updates" % string
Delegate.balance_updates_encoding))).
apply_results.mli 7 errors
(*****************************************************************************)
(* *)
(* Open Source License *)
(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com> *)
(* *)
(* Permission is hereby granted, free of charge, to any person obtaining a *)
(* copy of this software and associated documentation files (the "Software"),*)
(* to deal in the Software without restriction, including without limitation *)
(* the rights to use, copy, modify, merge, publish, distribute, sublicense, *)
(* and/or sell copies of the Software, and to permit persons to whom the *)
(* Software is furnished to do so, subject to the following conditions: *)
(* *)
(* The above copyright notice and this permission notice shall be included *)
(* in all copies or substantial portions of the Software. *)
(* *)
(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*)
(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, *)
(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL *)
(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*)
(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING *)
(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER *)
(* DEALINGS IN THE SOFTWARE. *)
(* *)
(*****************************************************************************)
(** Result of applying an operation, can be used for experimenting
with protocol updates, by clients to print out a summary of the
operation at pre-injection simulation and at confirmation time,
and by block explorers. *)
open Alpha_context
(** Result of applying a {!Operation.t}. Follows the same structure. *)
type 'kind operation_metadata = {contents : 'kind contents_result_list}
and packed_operation_metadata =
| Operation_metadata : 'kind operation_metadata -> packed_operation_metadata
| No_operation_metadata : packed_operation_metadata
(** Result of applying a {!Operation.contents_list}. Follows the same structure. *)
and 'kind contents_result_list =
| Single_result : 'kind contents_result -> 'kind contents_result_list
| Cons_result :
'kind Kind.manager contents_result
* 'rest Kind.manager contents_result_list
-> ('kind * 'rest) Kind.manager contents_result_list
and packed_contents_result_list =
| Contents_result_list :
'kind contents_result_list
-> packed_contents_result_list
(** Result of applying an {!Operation.contents}. Follows the same structure. *)
and 'kind contents_result =
| Endorsement_result : {
balance_updates : Delegate.balance_updates;
delegate : Signature.Public_key_hash.t;
slots : int list;
}
-> Kind.endorsement contents_result
| Seed_nonce_revelation_result :
Delegate.balance_updates
-> Kind.seed_nonce_revelation contents_result
| Double_endorsement_evidence_result :
Delegate.balance_updates
-> Kind.double_endorsement_evidence contents_result
| Double_baking_evidence_result :
Delegate.balance_updates
-> Kind.double_baking_evidence contents_result
| Activate_account_result :
Delegate.balance_updates
-> Kind.activate_account contents_result
| Proposals_result : Kind.proposals contents_result
| Ballot_result : Kind.ballot contents_result
| Manager_operation_result : {
balance_updates : Delegate.balance_updates;
operation_result : 'kind manager_operation_result;
internal_operation_results : packed_internal_operation_result list;
}
-> 'kind Kind.manager contents_result
and packed_contents_result =
| Contents_result : 'kind contents_result -> packed_contents_result
(** The result of an operation in the queue. [Skipped] ones should
always be at the tail, and after a single [Failed]. *)
and 'kind manager_operation_result =
| Applied of 'kind successful_manager_operation_result
| Backtracked of
'kind successful_manager_operation_result * error list option
| Failed : 'kind Kind.manager * error list -> 'kind manager_operation_result
| Skipped : 'kind Kind.manager -> 'kind manager_operation_result
(** Result of applying a {!manager_operation_content}, either internal
or external. *)
and _ successful_manager_operation_result =
| Reveal_result : {
consumed_gas : Z.t;
}
-> Kind.reveal successful_manager_operation_result
| Transaction_result : {
storage : Script.expr option;
big_map_diff : Contract.big_map_diff option;
balance_updates : Delegate.balance_updates;
originated_contracts : Contract.t list;
consumed_gas : Z.t;
storage_size : Z.t;
paid_storage_size_diff : Z.t;
allocated_destination_contract : bool;
}
-> Kind.transaction successful_manager_operation_result
| Origination_result : {
big_map_diff : Contract.big_map_diff option;
balance_updates : Delegate.balance_updates;
originated_contracts : Contract.t list;
consumed_gas : Z.t;
storage_size : Z.t;
paid_storage_size_diff : Z.t;
}
-> Kind.origination successful_manager_operation_result
| Delegation_result : {
consumed_gas : Z.t;
}
-> Kind.delegation successful_manager_operation_result
and packed_successful_manager_operation_result =
| Successful_manager_result :
'kind successful_manager_operation_result
-> packed_successful_manager_operation_result
and packed_internal_operation_result =
| Internal_operation_result :
'kind internal_operation * 'kind manager_operation_result
-> packed_internal_operation_result
(** Serializer for {!packed_operation_result}. *)
val operation_metadata_encoding : packed_operation_metadata Data_encoding.t
val operation_data_and_metadata_encoding :
(Operation.packed_protocol_data * packed_operation_metadata) Data_encoding.t
type 'kind contents_and_result_list =
| Single_and_result :
'kind Alpha_context.contents * 'kind contents_result
-> 'kind contents_and_result_list
| Cons_and_result :
'kind Kind.manager Alpha_context.contents
* 'kind Kind.manager contents_result
* 'rest Kind.manager contents_and_result_list
-> ('kind * 'rest) Kind.manager contents_and_result_list
type packed_contents_and_result_list =
| Contents_and_result_list :
'kind contents_and_result_list
-> packed_contents_and_result_list
val contents_and_result_list_encoding :
packed_contents_and_result_list Data_encoding.t
val pack_contents_list :
'kind contents_list ->
'kind contents_result_list ->
'kind contents_and_result_list
val unpack_contents_list :
'kind contents_and_result_list ->
'kind contents_list * 'kind contents_result_list
val to_list : packed_contents_result_list -> packed_contents_result list
val of_list : packed_contents_result list -> packed_contents_result_list
type ('a, 'b) eq = Eq : ('a, 'a) eq
val kind_equal_list :
'kind contents_list ->
'kind2 contents_result_list ->
('kind, 'kind2) eq option
type block_metadata = {
baker : Signature.Public_key_hash.t;
level : Level.t;
voting_period_kind : Voting_period.kind;
nonce_hash : Nonce_hash.t option;
consumed_gas : Z.t;
deactivated : Signature.Public_key_hash.t list;
balance_updates : Delegate.balance_updates;
}
val block_metadata_encoding : block_metadata Data_encoding.encoding
apply_results_mli.v
Require Import OCaml.OCaml.
Local Open Scope Z_scope.
Local Open Scope type_scope.
Import ListNotations.
Reserved Notation "'operation_metadata".
Reserved Notation "'packed_operation_metadata".
Reserved Notation "'contents_result_list".
Reserved Notation "'packed_contents_result_list".
Reserved Notation "'contents_result".
Reserved Notation "'packed_contents_result".
Reserved Notation "'manager_operation_result".
Reserved Notation "'successful_manager_operation_result".
Reserved Notation "'packed_successful_manager_operation_result".
Reserved Notation "'packed_internal_operation_result".
Module operation_metadata_skeleton.
Record record {contents : Set} := {
contents : contents }.
Arguments record : clear implicits.
End operation_metadata_skeleton.
Definition operation_metadata_skeleton := operation_metadata_skeleton.record.
Inductive packed_operation_metadata_gadt : Set :=
| Operation_metadata : forall {kind : Set},
'operation_metadata kind -> packed_operation_metadata_gadt
| No_operation_metadata : packed_operation_metadata_gadt
with contents_result_list_gadt : Set :=
| Single_result : forall {kind : Set},
'contents_result kind -> contents_result_list_gadt
| Cons_result : forall {kind : Set},
'contents_result (Tezos_raw_protocol_alpha.Alpha_context.Kind.manager kind) ->
contents_result_list_gadt -> contents_result_list_gadt
with packed_contents_result_list_gadt : Set :=
| Contents_result_list : forall {kind : Set},
'contents_result_list kind -> packed_contents_result_list_gadt
with contents_result_gadt : Set :=
| Endorsement_result :
Tezos_raw_protocol_alpha.Alpha_context.Delegate.balance_updates ->
Tezos_protocol_environment_alpha__Environment.Signature.Public_key_hash.t ->
list Z -> contents_result_gadt
| Seed_nonce_revelation_result :
Tezos_raw_protocol_alpha.Alpha_context.Delegate.balance_updates ->
contents_result_gadt
| Double_endorsement_evidence_result :
Tezos_raw_protocol_alpha.Alpha_context.Delegate.balance_updates ->
contents_result_gadt
| Double_baking_evidence_result :
Tezos_raw_protocol_alpha.Alpha_context.Delegate.balance_updates ->
contents_result_gadt
| Activate_account_result :
Tezos_raw_protocol_alpha.Alpha_context.Delegate.balance_updates ->
contents_result_gadt
| Proposals_result : contents_result_gadt
| Ballot_result : contents_result_gadt
| Manager_operation_result : forall {kind : Set},
Tezos_raw_protocol_alpha.Alpha_context.Delegate.balance_updates ->
'manager_operation_result kind -> list 'packed_internal_operation_result ->
contents_result_gadt
with packed_contents_result_gadt : Set :=
| Contents_result : forall {kind : Set},
'contents_result kind -> packed_contents_result_gadt
with manager_operation_result_gadt : Set :=
| Applied : forall {kind : Set},
'successful_manager_operation_result kind -> manager_operation_result_gadt
| Backtracked : forall {kind : Set},
'successful_manager_operation_result kind ->
option
(list Tezos_protocol_environment_alpha__Environment.Error_monad.__error) ->
manager_operation_result_gadt
| Failed : forall {kind : Set},
Tezos_raw_protocol_alpha.Alpha_context.Kind.manager kind ->
list Tezos_protocol_environment_alpha__Environment.Error_monad.__error ->
manager_operation_result_gadt
| Skipped : forall {kind : Set},
Tezos_raw_protocol_alpha.Alpha_context.Kind.manager kind ->
manager_operation_result_gadt
with successful_manager_operation_result_gadt : Set :=
| Reveal_result :
Tezos_protocol_environment_alpha__Environment.Z.t ->
successful_manager_operation_result_gadt
| Transaction_result :
option Tezos_raw_protocol_alpha.Alpha_context.Script.expr ->
option Tezos_raw_protocol_alpha.Alpha_context.Contract.big_map_diff ->
Tezos_raw_protocol_alpha.Alpha_context.Delegate.balance_updates ->
list Tezos_raw_protocol_alpha.Alpha_context.Contract.t ->
Tezos_protocol_environment_alpha__Environment.Z.t ->
Tezos_protocol_environment_alpha__Environment.Z.t ->
Tezos_protocol_environment_alpha__Environment.Z.t -> bool ->
successful_manager_operation_result_gadt
| Origination_result :
option Tezos_raw_protocol_alpha.Alpha_context.Contract.big_map_diff ->
Tezos_raw_protocol_alpha.Alpha_context.Delegate.balance_updates ->
list Tezos_raw_protocol_alpha.Alpha_context.Contract.t ->
Tezos_protocol_environment_alpha__Environment.Z.t ->
Tezos_protocol_environment_alpha__Environment.Z.t ->
Tezos_protocol_environment_alpha__Environment.Z.t ->
successful_manager_operation_result_gadt
| Delegation_result :
Tezos_protocol_environment_alpha__Environment.Z.t ->
successful_manager_operation_result_gadt
with packed_successful_manager_operation_result_gadt : Set :=
| Successful_manager_result : forall {kind : Set},
'successful_manager_operation_result kind ->
packed_successful_manager_operation_result_gadt
with packed_internal_operation_result_gadt : Set :=
| Internal_operation_result : forall {kind : Set},
Tezos_raw_protocol_alpha.Alpha_context.internal_operation kind ->
'manager_operation_result kind -> packed_internal_operation_result_gadt
where "'operation_metadata" := (fun (kind : Set) =>
operation_metadata_skeleton ('contents_result_list kind))
and "'packed_operation_metadata" := (packed_operation_metadata_gadt)
and "'contents_result_list" := (fun (kind : Set) => contents_result_list_gadt)
and "'packed_contents_result_list" := (packed_contents_result_list_gadt)
and "'contents_result" := (fun (kind : Set) => contents_result_gadt)
and "'packed_contents_result" := (packed_contents_result_gadt)
and "'manager_operation_result" := (fun (kind : Set) =>
manager_operation_result_gadt)
and "'successful_manager_operation_result" := (fun (_ : Set) =>
successful_manager_operation_result_gadt)
and "'packed_successful_manager_operation_result" :=
(packed_successful_manager_operation_result_gadt)
and "'packed_internal_operation_result" :=
(packed_internal_operation_result_gadt).
Definition operation_metadata := 'operation_metadata.
Definition packed_operation_metadata := 'packed_operation_metadata.
Definition contents_result_list := 'contents_result_list.
Definition packed_contents_result_list := 'packed_contents_result_list.
Definition contents_result := 'contents_result.
Definition packed_contents_result := 'packed_contents_result.
Definition manager_operation_result := 'manager_operation_result.
Definition successful_manager_operation_result :=
'successful_manager_operation_result.
Definition packed_successful_manager_operation_result :=
'packed_successful_manager_operation_result.
Definition packed_internal_operation_result :=
'packed_internal_operation_result.
Parameter operation_metadata_encoding :
Tezos_protocol_environment_alpha__Environment.Data_encoding.t
packed_operation_metadata.
Parameter operation_data_and_metadata_encoding :
Tezos_protocol_environment_alpha__Environment.Data_encoding.t
(Tezos_raw_protocol_alpha.Alpha_context.Operation.packed_protocol_data *
packed_operation_metadata).
Reserved Notation "'contents_and_result_list".
Inductive contents_and_result_list_gadt : Set :=
| Single_and_result : forall {kind : Set},
Tezos_raw_protocol_alpha.Alpha_context.contents kind ->
contents_result kind -> contents_and_result_list_gadt
| Cons_and_result : forall {kind : Set},
Tezos_raw_protocol_alpha.Alpha_context.contents
(Tezos_raw_protocol_alpha.Alpha_context.Kind.manager kind) ->
contents_result (Tezos_raw_protocol_alpha.Alpha_context.Kind.manager kind) ->
contents_and_result_list_gadt -> contents_and_result_list_gadt
where "'contents_and_result_list" := (fun (kind : Set) =>
contents_and_result_list_gadt).
Definition contents_and_result_list := 'contents_and_result_list.
Reserved Notation "'packed_contents_and_result_list".
Inductive packed_contents_and_result_list_gadt : Set :=
| Contents_and_result_list : forall {kind : Set},
contents_and_result_list kind -> packed_contents_and_result_list_gadt
where "'packed_contents_and_result_list" :=
(packed_contents_and_result_list_gadt).
Definition packed_contents_and_result_list := 'packed_contents_and_result_list.
Parameter contents_and_result_list_encoding :
Tezos_protocol_environment_alpha__Environment.Data_encoding.t
packed_contents_and_result_list.
Parameter pack_contents_list : forall {kind : Set},
Tezos_raw_protocol_alpha.Alpha_context.contents_list kind ->
contents_result_list kind -> contents_and_result_list kind.
Parameter unpack_contents_list : forall {kind : Set},
contents_and_result_list kind ->
Tezos_raw_protocol_alpha.Alpha_context.contents_list kind *
contents_result_list kind.
Parameter to_list : packed_contents_result_list -> list packed_contents_result.
Parameter of_list : list packed_contents_result -> packed_contents_result_list.
Reserved Notation "'eq".
Inductive eq_gadt : Set :=
| Eq : eq_gadt
where "'eq" := (fun (a b : Set) => eq_gadt).
Definition eq := 'eq.
Parameter kind_equal_list : forall {kind kind2 : Set},
Tezos_raw_protocol_alpha.Alpha_context.contents_list kind ->
contents_result_list kind2 -> option (eq kind kind2).
Module block_metadata.
Record record := {
baker :
Tezos_protocol_environment_alpha__Environment.Signature.Public_key_hash.t;
level : Tezos_raw_protocol_alpha.Alpha_context.Level.t;
voting_period_kind :
Tezos_raw_protocol_alpha.Alpha_context.Voting_period.kind;
nonce_hash : option Tezos_raw_protocol_alpha.Nonce_hash.t;
consumed_gas : Tezos_protocol_environment_alpha__Environment.Z.t;
deactivated :
list
Tezos_protocol_environment_alpha__Environment.Signature.Public_key_hash.t;
balance_updates :
Tezos_raw_protocol_alpha.Alpha_context.Delegate.balance_updates }.
End block_metadata.
Definition block_metadata := block_metadata.record.
Parameter block_metadata_encoding :
Tezos_protocol_environment_alpha__Environment.Data_encoding.encoding
block_metadata.
baking.ml 25 errors
(*****************************************************************************)
(* *)
(* Open Source License *)
(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com> *)
(* *)
(* Permission is hereby granted, free of charge, to any person obtaining a *)
(* copy of this software and associated documentation files (the "Software"),*)
(* to deal in the Software without restriction, including without limitation *)
(* the rights to use, copy, modify, merge, publish, distribute, sublicense, *)
(* and/or sell copies of the Software, and to permit persons to whom the *)
(* Software is furnished to do so, subject to the following conditions: *)
(* *)
(* The above copyright notice and this permission notice shall be included *)
(* in all copies or substantial portions of the Software. *)
(* *)
(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*)
(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, *)
(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL *)
(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*)
(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING *)
(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER *)
(* DEALINGS IN THE SOFTWARE. *)
(* *)
(*****************************************************************************)
open Alpha_context
open Misc
type error += Invalid_fitness_gap of int64 * int64 (* `Permanent *)
type error += Timestamp_too_early of Timestamp.t * Timestamp.t
(* `Permanent *)
type error += Unexpected_endorsement (* `Permanent *)
type error +=
| Invalid_block_signature of Block_hash.t * Signature.Public_key_hash.t
(* `Permanent *)
type error += Invalid_signature (* `Permanent *)
type error += Invalid_stamp (* `Permanent *)
let () =
register_error_kind
`Permanent
~id:"baking.timestamp_too_early"
~title:"Block forged too early"
~description:
"The block timestamp is before the first slot for this baker at this \
level"
~pp:(fun ppf (r, p) ->
Format.fprintf
ppf
"Block forged too early (%a is before %a)"
Time.pp_hum
p
Time.pp_hum
r)
Data_encoding.(
obj2 (req "minimum" Time.encoding) (req "provided" Time.encoding))
(function Timestamp_too_early (r, p) -> Some (r, p) | _ -> None)
(fun (r, p) -> Timestamp_too_early (r, p)) ;
register_error_kind
`Permanent
~id:"baking.invalid_fitness_gap"
~title:"Invalid fitness gap"
~description:"The gap of fitness is out of bounds"
~pp:(fun ppf (m, g) ->
Format.fprintf ppf "The gap of fitness %Ld is not between 0 and %Ld" g m)
Data_encoding.(obj2 (req "maximum" int64) (req "provided" int64))
(function Invalid_fitness_gap (m, g) -> Some (m, g) | _ -> None)
(fun (m, g) -> Invalid_fitness_gap (m, g)) ;
register_error_kind
`Permanent
~id:"baking.invalid_block_signature"
~title:"Invalid block signature"
~description:"A block was not signed with the expected private key."
~pp:(fun ppf (block, pkh) ->
Format.fprintf
ppf
"Invalid signature for block %a. Expected: %a."
Block_hash.pp_short
block
Signature.Public_key_hash.pp_short
pkh)
Data_encoding.(
obj2
(req "block" Block_hash.encoding)
(req "expected" Signature.Public_key_hash.encoding))
(function
| Invalid_block_signature (block, pkh) -> Some (block, pkh) | _ -> None)
(fun (block, pkh) -> Invalid_block_signature (block, pkh)) ;
register_error_kind
`Permanent
~id:"baking.invalid_signature"
~title:"Invalid block signature"
~description:"The block's signature is invalid"
~pp:(fun ppf () -> Format.fprintf ppf "Invalid block signature")
Data_encoding.empty
(function Invalid_signature -> Some () | _ -> None)
(fun () -> Invalid_signature) ;
register_error_kind
`Permanent
~id:"baking.insufficient_proof_of_work"
~title:"Insufficient block proof-of-work stamp"
~description:"The block's proof-of-work stamp is insufficient"
~pp:(fun ppf () -> Format.fprintf ppf "Insufficient proof-of-work stamp")
Data_encoding.empty
(function Invalid_stamp -> Some () | _ -> None)
(fun () -> Invalid_stamp) ;
register_error_kind
`Permanent
~id:"baking.unexpected_endorsement"
~title:"Endorsement from unexpected delegate"
~description:
"The operation is signed by a delegate without endorsement rights."
~pp:(fun ppf () ->
Format.fprintf
ppf
"The endorsement is signed by a delegate without endorsement rights.")
Data_encoding.unit
(function Unexpected_endorsement -> Some () | _ -> None)
(fun () -> Unexpected_endorsement)
let minimal_time c priority pred_timestamp =
let priority = Int32.of_int priority in
let rec cumsum_time_between_blocks acc durations p =
if Compare.Int32.( <= ) p 0l then ok acc
else
match durations with
| [] ->
cumsum_time_between_blocks acc [Period.one_minute] p
| [last] ->
Period.mult p last >>? fun period -> Timestamp.(acc +? period)
| first :: durations ->
Timestamp.(acc +? first)
>>? fun acc ->
let p = Int32.pred p in
cumsum_time_between_blocks acc durations p
in
Lwt.return
(cumsum_time_between_blocks
pred_timestamp
(Constants.time_between_blocks c)
(Int32.succ priority))
let earlier_predecessor_timestamp ctxt level =
let current = Level.current ctxt in
let current_timestamp = Timestamp.current ctxt in
let gap = Level.diff level current in
let step = List.hd (Constants.time_between_blocks ctxt) in
if Compare.Int32.(gap < 1l) then
failwith "Baking.earlier_block_timestamp: past block."
else
Lwt.return (Period.mult (Int32.pred gap) step)
>>=? fun delay ->
Lwt.return Timestamp.(current_timestamp +? delay)
>>=? fun result -> return result
let check_timestamp c priority pred_timestamp =
minimal_time c priority pred_timestamp
>>=? fun minimal_time ->
let timestamp = Alpha_context.Timestamp.current c in
Lwt.return
(record_trace
(Timestamp_too_early (minimal_time, timestamp))
Timestamp.(timestamp -? minimal_time))
let check_baking_rights c {Block_header.priority; _} pred_timestamp =
let level = Level.current c in
Roll.baking_rights_owner c level ~priority
>>=? fun delegate ->
check_timestamp c priority pred_timestamp
>>=? fun block_delay -> return (delegate, block_delay)
type error += Incorrect_priority (* `Permanent *)
type error += Incorrect_number_of_endorsements (* `Permanent *)
let () =
register_error_kind
`Permanent
~id:"incorrect_priority"
~title:"Incorrect priority"
~description:"Block priority must be non-negative."
~pp:(fun ppf () ->
Format.fprintf ppf "The block priority must be non-negative.")
Data_encoding.unit
(function Incorrect_priority -> Some () | _ -> None)
(fun () -> Incorrect_priority)
let () =
let description =
"The number of endorsements must be non-negative and at most the \
endosers_per_block constant."
in
register_error_kind
`Permanent
~id:"incorrect_number_of_endorsements"
~title:"Incorrect number of endorsements"
~description
~pp:(fun ppf () -> Format.fprintf ppf "%s" description)
Data_encoding.unit
(function Incorrect_number_of_endorsements -> Some () | _ -> None)
(fun () -> Incorrect_number_of_endorsements)
let baking_reward ctxt ~block_priority:prio ~included_endorsements:num_endo =
fail_unless Compare.Int.(prio >= 0) Incorrect_priority
>>=? fun () ->
let max_endorsements = Constants.endorsers_per_block ctxt in
fail_unless
Compare.Int.(num_endo >= 0 && num_endo <= max_endorsements)
Incorrect_number_of_endorsements
>>=? fun () ->
let prio_factor_denominator = Int64.(succ (of_int prio)) in
let endo_factor_numerator =
Int64.of_int (8 + (2 * num_endo / max_endorsements))
in
let endo_factor_denominator = 10L in
Lwt.return
Tez.(
Constants.block_reward ctxt *? endo_factor_numerator
>>? fun val1 ->
val1 /? endo_factor_denominator
>>? fun val2 -> val2 /? prio_factor_denominator)
let endorsing_reward ctxt ~block_priority:prio n =
if Compare.Int.(prio >= 0) then
Lwt.return
Tez.(Constants.endorsement_reward ctxt /? Int64.(succ (of_int prio)))
>>=? fun tez -> Lwt.return Tez.(tez *? Int64.of_int n)
else fail Incorrect_priority
let baking_priorities c level =
let rec f priority =
Roll.baking_rights_owner c level ~priority
>>=? fun delegate -> return (LCons (delegate, fun () -> f (succ priority)))
in
f 0
let endorsement_rights c level =
fold_left_s
(fun acc slot ->
Roll.endorsement_rights_owner c level ~slot
>>=? fun pk ->
let pkh = Signature.Public_key.hash pk in
let right =
match Signature.Public_key_hash.Map.find_opt pkh acc with
| None ->
(pk, [slot], false)
| Some (pk, slots, used) ->
(pk, slot :: slots, used)
in
return (Signature.Public_key_hash.Map.add pkh right acc))
Signature.Public_key_hash.Map.empty
(0 --> (Constants.endorsers_per_block c - 1))
let check_endorsement_rights ctxt chain_id (op : Kind.endorsement Operation.t)
=
let current_level = Level.current ctxt in
let (Single (Endorsement {level; _})) = op.protocol_data.contents in
( if Raw_level.(succ level = current_level.level) then
return (Alpha_context.allowed_endorsements ctxt)
else endorsement_rights ctxt (Level.from_raw ctxt level) )
>>=? fun endorsements ->
match
Signature.Public_key_hash.Map.fold (* no find_first *)
(fun pkh (pk, slots, used) acc ->
match Operation.check_signature_sync pk chain_id op with
| Error _ ->
acc
| Ok () ->
Some (pkh, slots, used))
endorsements
None
with
| None ->
fail Unexpected_endorsement
| Some v ->
return v
let select_delegate delegate delegate_list max_priority =
let rec loop acc l n =
if Compare.Int.(n >= max_priority) then return (List.rev acc)
else
let (LCons (pk, t)) = l in
let acc =
if
Signature.Public_key_hash.equal
delegate
(Signature.Public_key.hash pk)
then n :: acc
else acc
in
t () >>=? fun t -> loop acc t (succ n)
in
loop [] delegate_list 0
let first_baking_priorities ctxt ?(max_priority = 32) delegate level =
baking_priorities ctxt level
>>=? fun delegate_list -> select_delegate delegate delegate_list max_priority
let check_hash hash stamp_threshold =
let bytes = Block_hash.to_bytes hash in
let word = MBytes.get_int64 bytes 0 in
Compare.Uint64.(word <= stamp_threshold)
let check_header_proof_of_work_stamp shell contents stamp_threshold =
let hash =
Block_header.hash
{shell; protocol_data = {contents; signature = Signature.zero}}
in
check_hash hash stamp_threshold
let check_proof_of_work_stamp ctxt block =
let proof_of_work_threshold = Constants.proof_of_work_threshold ctxt in
if
check_header_proof_of_work_stamp
block.Block_header.shell
block.protocol_data.contents
proof_of_work_threshold
then return_unit
else fail Invalid_stamp
let check_signature block chain_id key =
let check_signature key
{Block_header.shell; protocol_data = {contents; signature}} =
let unsigned_header =
Data_encoding.Binary.to_bytes_exn
Block_header.unsigned_encoding
(shell, contents)
in
Signature.check
~watermark:(Block_header chain_id)
key
signature
unsigned_header
in
if check_signature key block then return_unit
else
fail
(Invalid_block_signature
(Block_header.hash block, Signature.Public_key.hash key))
let max_fitness_gap _ctxt = 1L
let check_fitness_gap ctxt (block : Block_header.t) =
let current_fitness = Fitness.current ctxt in
Lwt.return (Fitness.to_int64 block.shell.fitness)
>>=? fun announced_fitness ->
let gap = Int64.sub announced_fitness current_fitness in
if Compare.Int64.(gap <= 0L || max_fitness_gap ctxt < gap) then
fail (Invalid_fitness_gap (max_fitness_gap ctxt, gap))
else return_unit
let last_of_a_cycle ctxt l =
Compare.Int32.(
Int32.succ l.Level.cycle_position = Constants.blocks_per_cycle ctxt)
let dawn_of_a_new_cycle ctxt =
let level = Level.current ctxt in
if last_of_a_cycle ctxt level then return_some level.cycle else return_none
let minimum_allowed_endorsements ctxt ~block_delay =
let minimum = Constants.initial_endorsers ctxt in
let delay_per_missing_endorsement =
Int64.to_int
(Period.to_seconds (Constants.delay_per_missing_endorsement ctxt))
in
let reduced_time_constraint =
let delay = Int64.to_int (Period.to_seconds block_delay) in
if Compare.Int.(delay_per_missing_endorsement = 0) then delay
else delay / delay_per_missing_endorsement
in
Compare.Int.max 0 (minimum - reduced_time_constraint)
let minimal_valid_time ctxt ~priority ~endorsing_power =
let predecessor_timestamp = Timestamp.current ctxt in
minimal_time ctxt priority predecessor_timestamp
>>=? fun minimal_time ->
let minimal_required_endorsements = Constants.initial_endorsers ctxt in
let delay_per_missing_endorsement =
Constants.delay_per_missing_endorsement ctxt
in
let missing_endorsements =
Compare.Int.max 0 (minimal_required_endorsements - endorsing_power)
in
match
Period.mult
(Int32.of_int missing_endorsements)
delay_per_missing_endorsement
with
| Ok delay ->
return (Time.add minimal_time (Period.to_seconds delay))
| Error _ as err ->
Lwt.return err
baking_ml.v
Require Import OCaml.OCaml.
Local Open Scope Z_scope.
Local Open Scope type_scope.
Import ListNotations.
Import Alpha_context.
Import Misc.
(* ❌ Structure item `typext` not handled. *)
type_extension
(* ❌ Structure item `typext` not handled. *)
type_extension
(* ❌ Structure item `typext` not handled. *)
type_extension
(* ❌ Structure item `typext` not handled. *)
type_extension
(* ❌ Structure item `typext` not handled. *)
type_extension
(* ❌ Structure item `typext` not handled. *)
type_extension
(* ❌ Top-level evaluations are considered as an error as sources of side-effects *)
Compute
(* ❌ Sequences of instructions are not handled (operator ";") *)
let _ :=
register_error_kind
(* ❌ Variants not supported *)
variant "baking.timestamp_too_early" % string
"Block forged too early" % string
"The block timestamp is before the first slot for this baker at this level"
% string
(Some
(fun ppf =>
fun function_parameter =>
let '(r, p) := function_parameter in
Format.fprintf ppf
(Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Format
(Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.String_literal
"Block forged too early (" % string
(Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Alpha
(Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.String_literal
" is before " % string
(Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Alpha
(Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Char_literal
")" % char
Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.End_of_format)))))
"Block forged too early (%a is before %a)" % string) Time.pp_hum
p Time.pp_hum r))
(obj2 (req None None "minimum" % string Time.encoding)
(req None None "provided" % string Time.encoding))
(fun function_parameter =>
match function_parameter with
|
Tezos_protocol_environment_alpha__Environment.Error_monad.Timestamp_too_early
r p => Some (r, p)
| _ => None
end)
(fun function_parameter =>
let '(r, p) := function_parameter in
Tezos_protocol_environment_alpha__Environment.Error_monad.Timestamp_too_early
r p) in
(* ❌ Sequences of instructions are not handled (operator ";") *)
let _ :=
register_error_kind
(* ❌ Variants not supported *)
variant "baking.invalid_fitness_gap" % string
"Invalid fitness gap" % string
"The gap of fitness is out of bounds" % string
(Some
(fun ppf =>
fun function_parameter =>
let '(m, g) := function_parameter in
Format.fprintf ppf
(Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Format
(Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.String_literal
"The gap of fitness " % string
(Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Int64
Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Int_d
Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.No_padding
Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.No_precision
(Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.String_literal
" is not between 0 and " % string
(Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Int64
Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Int_d
Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.No_padding
Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.No_precision
Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.End_of_format))))
"The gap of fitness %Ld is not between 0 and %Ld" % string) g m))
(obj2 (req None None "maximum" % string __int64_value)
(req None None "provided" % string __int64_value))
(fun function_parameter =>
match function_parameter with
|
Tezos_protocol_environment_alpha__Environment.Error_monad.Invalid_fitness_gap
m g => Some (m, g)
| _ => None
end)
(fun function_parameter =>
let '(m, g) := function_parameter in
Tezos_protocol_environment_alpha__Environment.Error_monad.Invalid_fitness_gap
m g) in
(* ❌ Sequences of instructions are not handled (operator ";") *)
let _ :=
register_error_kind
(* ❌ Variants not supported *)
variant "baking.invalid_block_signature" % string
"Invalid block signature" % string
"A block was not signed with the expected private key." % string
(Some
(fun ppf =>
fun function_parameter =>
let '(block, pkh) := function_parameter in
Format.fprintf ppf
(Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Format
(Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.String_literal
"Invalid signature for block " % string
(Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Alpha
(Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.String_literal
". Expected: " % string
(Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Alpha
(Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Char_literal
"." % char
Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.End_of_format)))))
"Invalid signature for block %a. Expected: %a." % string)
Block_hash.pp_short block Signature.Public_key_hash.pp_short pkh))
(obj2 (req None None "block" % string Block_hash.encoding)
(req None None "expected" % string Signature.Public_key_hash.encoding))
(fun function_parameter =>
match function_parameter with
|
Tezos_protocol_environment_alpha__Environment.Error_monad.Invalid_block_signature
block pkh => Some (block, pkh)
| _ => None
end)
(fun function_parameter =>
let '(block, pkh) := function_parameter in
Tezos_protocol_environment_alpha__Environment.Error_monad.Invalid_block_signature
block pkh) in
(* ❌ Sequences of instructions are not handled (operator ";") *)
let _ :=
register_error_kind
(* ❌ Variants not supported *)
variant "baking.invalid_signature" % string
"Invalid block signature" % string
"The block's signature is invalid" % string
(Some
(fun ppf =>
fun function_parameter =>
let 'tt := function_parameter in
Format.fprintf ppf
(Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Format
(Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.String_literal
"Invalid block signature" % string
Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.End_of_format)
"Invalid block signature" % string))) Data_encoding.empty
(fun function_parameter =>
match function_parameter with
|
Tezos_protocol_environment_alpha__Environment.Error_monad.Invalid_signature
=> Some tt
| _ => None
end)
(fun function_parameter =>
let 'tt := function_parameter in
Tezos_protocol_environment_alpha__Environment.Error_monad.Invalid_signature)
in
(* ❌ Sequences of instructions are not handled (operator ";") *)
let _ :=
register_error_kind
(* ❌ Variants not supported *)
variant "baking.insufficient_proof_of_work" % string
"Insufficient block proof-of-work stamp" % string
"The block's proof-of-work stamp is insufficient" % string
(Some
(fun ppf =>
fun function_parameter =>
let 'tt := function_parameter in
Format.fprintf ppf
(Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Format
(Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.String_literal
"Insufficient proof-of-work stamp" % string
Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.End_of_format)
"Insufficient proof-of-work stamp" % string)))
Data_encoding.empty
(fun function_parameter =>
match function_parameter with
|
Tezos_protocol_environment_alpha__Environment.Error_monad.Invalid_stamp
=> Some tt
| _ => None
end)
(fun function_parameter =>
let 'tt := function_parameter in
Tezos_protocol_environment_alpha__Environment.Error_monad.Invalid_stamp)
in
register_error_kind
(* ❌ Variants not supported *)
variant "baking.unexpected_endorsement" % string
"Endorsement from unexpected delegate" % string
"The operation is signed by a delegate without endorsement rights." % string
(Some
(fun ppf =>
fun function_parameter =>
let 'tt := function_parameter in
Format.fprintf ppf
(Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Format
(Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.String_literal
"The endorsement is signed by a delegate without endorsement rights."
% string
Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.End_of_format)
"The endorsement is signed by a delegate without endorsement rights."
% string))) Data_encoding.__unit_value
(fun function_parameter =>
match function_parameter with
|
Tezos_protocol_environment_alpha__Environment.Error_monad.Unexpected_endorsement
=> Some tt
| _ => None
end)
(fun function_parameter =>
let 'tt := function_parameter in
Tezos_protocol_environment_alpha__Environment.Error_monad.Unexpected_endorsement).
Definition minimal_time
(c : Tezos_raw_protocol_alpha__Alpha_context.context) (priority : Z)
(pred_timestamp : Tezos_raw_protocol_alpha.Alpha_context.Timestamp.time)
: Tezos_protocol_environment_alpha__Environment.Lwt.t
(Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
Tezos_raw_protocol_alpha.Alpha_context.Timestamp.time) :=
let priority := Int32.of_int priority in
let fix cumsum_time_between_blocks
(acc : Tezos_raw_protocol_alpha.Alpha_context.Timestamp.time) (durations :
list Tezos_raw_protocol_alpha.Alpha_context.Period.period) (p :
Tezos_protocol_environment_alpha__Environment.Compare.Int32.t)
: Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
Tezos_raw_protocol_alpha.Alpha_context.Timestamp.time :=
if
Compare.Int32.op_lteq p
(* ❌ Constant of type int32 is converted to int *)
0 then
ok acc
else
match durations with
| [] => cumsum_time_between_blocks acc (cons Period.one_minute []) p
| cons last [] =>
op_gtgtquestion (Period.mult p last)
(fun period => op_plusquestion acc period)
| cons first durations =>
op_gtgtquestion (op_plusquestion acc first)
(fun acc =>
let p := Int32.pred p in
cumsum_time_between_blocks acc durations p)
end in
Lwt.__return
(cumsum_time_between_blocks pred_timestamp (Constants.time_between_blocks c)
(Int32.succ priority)).
Definition earlier_predecessor_timestamp
(ctxt : Tezos_raw_protocol_alpha__Alpha_context.context)
(level : Tezos_raw_protocol_alpha.Alpha_context.Level.level)
: Tezos_protocol_environment_alpha__Environment.Lwt.t
(Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
Tezos_raw_protocol_alpha.Alpha_context.Timestamp.time) :=
let current := Level.current ctxt in
let current_timestamp := Timestamp.current ctxt in
let gap := Level.diff level current in
let step := List.hd (Constants.time_between_blocks ctxt) in
if
op_lt gap
(* ❌ Constant of type int32 is converted to int *)
1 then
failwith "Baking.earlier_block_timestamp: past block." % string
else
op_gtgteqquestion (Lwt.__return (Period.mult (Int32.pred gap) step))
(fun delay =>
op_gtgteqquestion
(Lwt.__return (op_plusquestion current_timestamp delay))
(fun __result_value => __return __result_value)).
Definition check_timestamp
(c : Tezos_raw_protocol_alpha__Alpha_context.context) (priority : Z)
(pred_timestamp : Tezos_raw_protocol_alpha.Alpha_context.Timestamp.time)
: Tezos_protocol_environment_alpha__Environment.Lwt.t
(Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
Tezos_raw_protocol_alpha__Alpha_context.Period.t) :=
op_gtgteqquestion (minimal_time c priority pred_timestamp)
(fun minimal_time =>
let timestamp := Alpha_context.Timestamp.current c in
Lwt.__return
(record_trace
(Tezos_protocol_environment_alpha__Environment.Error_monad.Timestamp_too_early
minimal_time timestamp) (op_minusquestion timestamp minimal_time))).
Definition check_baking_rights
(c : Tezos_raw_protocol_alpha__Alpha_context.context)
(function_parameter :
Tezos_raw_protocol_alpha.Alpha_context.Block_header.contents)
: Tezos_raw_protocol_alpha.Alpha_context.Timestamp.time ->
Tezos_protocol_environment_alpha__Environment.Lwt.t
(Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
(Tezos_raw_protocol_alpha__Alpha_context.public_key *
Tezos_raw_protocol_alpha__Alpha_context.Period.t)) :=
let '{|
Tezos_raw_protocol_alpha.Alpha_context.Block_header.contents.priority :=
priority
|} := function_parameter in
fun pred_timestamp =>
let level := Level.current c in
op_gtgteqquestion (Roll.baking_rights_owner c level priority)
(fun delegate =>
op_gtgteqquestion (check_timestamp c priority pred_timestamp)
(fun block_delay => __return (delegate, block_delay))).
(* ❌ Structure item `typext` not handled. *)
type_extension
(* ❌ Structure item `typext` not handled. *)
type_extension
(* ❌ Top-level evaluations are considered as an error as sources of side-effects *)
Compute
register_error_kind
(* ❌ Variants not supported *)
variant "incorrect_priority" % string "Incorrect priority" % string
"Block priority must be non-negative." % string
(Some
(fun ppf =>
fun function_parameter =>
let 'tt := function_parameter in
Format.fprintf ppf
(Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Format
(Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.String_literal
"The block priority must be non-negative." % string
Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.End_of_format)
"The block priority must be non-negative." % string)))
Data_encoding.__unit_value
(fun function_parameter =>
match function_parameter with
|
Tezos_protocol_environment_alpha__Environment.Error_monad.Incorrect_priority
=> Some tt
| _ => None
end)
(fun function_parameter =>
let 'tt := function_parameter in
Tezos_protocol_environment_alpha__Environment.Error_monad.Incorrect_priority).
(* ❌ Top-level evaluations are considered as an error as sources of side-effects *)
Compute
let description :=
"The number of endorsements must be non-negative and at most the endosers_per_block constant."
% string in
register_error_kind
(* ❌ Variants not supported *)
variant "incorrect_number_of_endorsements" % string
"Incorrect number of endorsements" % string description
(Some
(fun ppf =>
fun function_parameter =>
let 'tt := function_parameter in
Format.fprintf ppf
(Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Format
(Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.String
Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.No_padding
Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.End_of_format)
"%s" % string) description)) Data_encoding.__unit_value
(fun function_parameter =>
match function_parameter with
|
Tezos_protocol_environment_alpha__Environment.Error_monad.Incorrect_number_of_endorsements
=> Some tt
| _ => None
end)
(fun function_parameter =>
let 'tt := function_parameter in
Tezos_protocol_environment_alpha__Environment.Error_monad.Incorrect_number_of_endorsements).
Definition baking_reward
(ctxt : Tezos_raw_protocol_alpha__Alpha_context.context)
(prio : Tezos_protocol_environment_alpha__Environment.Compare.Int.t)
(num_endo : Tezos_protocol_environment_alpha__Environment.Compare.Int.t)
: Tezos_protocol_environment_alpha__Environment.Lwt.t
(Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
Tezos_raw_protocol_alpha.Alpha_context.Tez.tez) :=
op_gtgteqquestion
(fail_unless (op_gteq prio 0)
Tezos_protocol_environment_alpha__Environment.Error_monad.Incorrect_priority)
(fun function_parameter =>
let 'tt := function_parameter in
let max_endorsements := Constants.endorsers_per_block ctxt in
op_gtgteqquestion
(fail_unless
(op_andand (op_gteq num_endo 0) (op_lteq num_endo max_endorsements))
Tezos_protocol_environment_alpha__Environment.Error_monad.Incorrect_number_of_endorsements)
(fun function_parameter =>
let 'tt := function_parameter in
let prio_factor_denominator := succ (of_int prio) in
let endo_factor_numerator :=
Int64.of_int
(op_plus 8 (op_div (op_star 2 num_endo) max_endorsements)) in
let endo_factor_denominator :=
(* ❌ Constant of type int64 is converted to int *)
10 in
Lwt.__return
(op_gtgtquestion
(op_starquestion (Constants.block_reward ctxt)
endo_factor_numerator)
(fun val1 =>
op_gtgtquestion (op_divquestion val1 endo_factor_denominator)
(fun val2 => op_divquestion val2 prio_factor_denominator))))).
Definition endorsing_reward
(ctxt : Tezos_raw_protocol_alpha__Alpha_context.context)
(prio : Tezos_protocol_environment_alpha__Environment.Compare.Int.t) (n : Z)
: Tezos_protocol_environment_alpha__Environment.Lwt.t
(Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
Tezos_raw_protocol_alpha.Alpha_context.Tez.tez) :=
if op_gteq prio 0 then
op_gtgteqquestion
(Lwt.__return
(op_divquestion (Constants.endorsement_reward ctxt) (succ (of_int prio))))
(fun tez => Lwt.__return (op_starquestion tez (Int64.of_int n)))
else
fail
Tezos_protocol_environment_alpha__Environment.Error_monad.Incorrect_priority.
Definition baking_priorities
(c : Tezos_raw_protocol_alpha__Alpha_context.context)
(level : Tezos_raw_protocol_alpha__Alpha_context.Level.t)
: Tezos_protocol_environment_alpha__Environment.Lwt.t
(Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
(Tezos_raw_protocol_alpha.Misc.lazy_list_t
Tezos_raw_protocol_alpha__Alpha_context.public_key)) :=
let fix f (priority : Z)
: Tezos_protocol_environment_alpha__Environment.Lwt.t
(Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
(Tezos_raw_protocol_alpha.Misc.lazy_list_t
Tezos_raw_protocol_alpha__Alpha_context.public_key)) :=
op_gtgteqquestion (Roll.baking_rights_owner c level priority)
(fun delegate =>
__return
(Tezos_raw_protocol_alpha.Misc.LCons delegate
(fun function_parameter =>
let 'tt := function_parameter in
f (succ priority)))) in
f 0.
Definition endorsement_rights
(c : Tezos_raw_protocol_alpha__Alpha_context.context)
(level : Tezos_raw_protocol_alpha__Alpha_context.Level.t)
: Tezos_protocol_environment_alpha__Environment.Lwt.t
(Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
(Tezos_protocol_environment_alpha__Environment.Signature.Public_key_hash.Map.t
(Tezos_raw_protocol_alpha__Alpha_context.public_key * list Z * bool))) :=
fold_left_s
(fun acc =>
fun slot =>
op_gtgteqquestion (Roll.endorsement_rights_owner c level slot)
(fun pk =>
let pkh := Signature.Public_key.__hash_value pk in
let right :=
match Signature.Public_key_hash.Map.find_opt pkh acc with
| None => (pk, (cons slot []), false)
| Some (pk, slots, used) => (pk, (cons slot slots), used)
end in
__return (Signature.Public_key_hash.Map.add pkh right acc)))
Signature.Public_key_hash.Map.empty
(op_minusminusgt 0 (op_minus (Constants.endorsers_per_block c) 1)).
Definition check_endorsement_rights
(ctxt : Tezos_raw_protocol_alpha__Alpha_context.context)
(chain_id : Tezos_protocol_environment_alpha__Environment.Chain_id.t)
(op :
Tezos_raw_protocol_alpha.Alpha_context.Operation.t
Tezos_raw_protocol_alpha.Alpha_context.Kind.endorsement)
: Tezos_protocol_environment_alpha__Environment.Lwt.t
(Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
(Tezos_protocol_environment_alpha__Environment.Signature.Public_key_hash.Map.key
* list Z * bool)) :=
let current_level := Level.current ctxt in
let
'Tezos_raw_protocol_alpha.Alpha_context.Single
(Tezos_raw_protocol_alpha.Alpha_context.Endorsement {|
Tezos_raw_protocol_alpha.Alpha_context.contents.Endorsement.level := level
|}) :=
Tezos_raw_protocol_alpha.Alpha_context.protocol_data.contents
(Tezos_raw_protocol_alpha.Alpha_context.operation.protocol_data op) in
op_gtgteqquestion
(if
op_eq (succ level)
(Tezos_raw_protocol_alpha.Alpha_context.Level.t.level current_level)
then
__return (Alpha_context.allowed_endorsements ctxt)
else
endorsement_rights ctxt (Level.from_raw ctxt None level))
(fun endorsements =>
match
Signature.Public_key_hash.Map.fold
(fun pkh =>
fun function_parameter =>
let '(pk, slots, used) := function_parameter in
fun acc =>
match Operation.check_signature_sync pk chain_id op with
|
Tezos_protocol_environment_alpha__Environment.Pervasives.Error
_ => acc
| Tezos_protocol_environment_alpha__Environment.Pervasives.Ok tt
=> Some (pkh, slots, used)
end) endorsements None with
| None =>
fail
Tezos_protocol_environment_alpha__Environment.Error_monad.Unexpected_endorsement
| Some v => __return v
end).
Definition select_delegate
(delegate :
Tezos_protocol_environment_alpha__Environment.Signature.Public_key_hash.t)
(delegate_list :
Tezos_raw_protocol_alpha.Misc.lazy_list_t
Tezos_protocol_environment_alpha__Environment.Signature.Public_key.t)
(max_priority : Tezos_protocol_environment_alpha__Environment.Compare.Int.t)
: Tezos_protocol_environment_alpha__Environment.Lwt.t
(Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
(list Tezos_protocol_environment_alpha__Environment.Compare.Int.t)) :=
let fix loop
(acc : list Tezos_protocol_environment_alpha__Environment.Compare.Int.t) (l
:
Tezos_raw_protocol_alpha.Misc.lazy_list_t
Tezos_protocol_environment_alpha__Environment.Signature.Public_key.t) (n :
Tezos_protocol_environment_alpha__Environment.Compare.Int.t)
: Tezos_protocol_environment_alpha__Environment.Lwt.t
(Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
(list Tezos_protocol_environment_alpha__Environment.Compare.Int.t)) :=
if op_gteq n max_priority then
__return (List.rev acc)
else
let 'Tezos_raw_protocol_alpha.Misc.LCons pk t := l in
let acc :=
if
Signature.Public_key_hash.equal delegate
(Signature.Public_key.__hash_value pk) then
cons n acc
else
acc in
op_gtgteqquestion (t tt) (fun t => loop acc t (succ n)) in
loop [] delegate_list 0.
Definition first_baking_priorities
(ctxt : Tezos_raw_protocol_alpha__Alpha_context.context)
(op_staroptstar :
option Tezos_protocol_environment_alpha__Environment.Compare.Int.t)
: Tezos_protocol_environment_alpha__Environment.Signature.Public_key_hash.t ->
Tezos_raw_protocol_alpha__Alpha_context.Level.t ->
Tezos_protocol_environment_alpha__Environment.Lwt.t
(Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
(list Tezos_protocol_environment_alpha__Environment.Compare.Int.t)) :=
let max_priority :=
match op_staroptstar with
| Some op_starsthstar => op_starsthstar
| None => 32
end in
fun delegate =>
fun level =>
op_gtgteqquestion (baking_priorities ctxt level)
(fun delegate_list =>
select_delegate delegate delegate_list max_priority).
Definition check_hash
(__hash_value : Tezos_protocol_environment_alpha__Environment.Block_hash.t)
(stamp_threshold :
Tezos_protocol_environment_alpha__Environment.Compare.Uint64.t) : bool :=
let __bytes_value := Block_hash.to_bytes __hash_value in
let word := MBytes.get_int64 __bytes_value 0 in
op_lteq word stamp_threshold.
Definition check_header_proof_of_work_stamp
(shell :
Tezos_protocol_environment_alpha__Environment.Block_header.shell_header)
(contents : Tezos_raw_protocol_alpha.Alpha_context.Block_header.contents)
(stamp_threshold :
Tezos_protocol_environment_alpha__Environment.Compare.Uint64.t) : bool :=
let __hash_value :=
Block_header.__hash_value
{| Tezos_raw_protocol_alpha.Alpha_context.Block_header.t.shell := shell;
Tezos_raw_protocol_alpha.Alpha_context.Block_header.t.protocol_data :=
{|
Tezos_raw_protocol_alpha.Alpha_context.Block_header.protocol_data.contents :=
contents;
Tezos_raw_protocol_alpha.Alpha_context.Block_header.protocol_data.signature :=
Signature.zero |} |} in
check_hash __hash_value stamp_threshold.
Definition check_proof_of_work_stamp
(ctxt : Tezos_raw_protocol_alpha__Alpha_context.context)
(block : Tezos_raw_protocol_alpha.Alpha_context.Block_header.t)
: Tezos_protocol_environment_alpha__Environment.Lwt.t
(Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult unit) :=
let proof_of_work_threshold := Constants.proof_of_work_threshold ctxt in
if
check_header_proof_of_work_stamp
(Tezos_raw_protocol_alpha.Alpha_context.Block_header.t.shell block)
(Tezos_raw_protocol_alpha.Alpha_context.Block_header.protocol_data.contents
(Tezos_raw_protocol_alpha.Alpha_context.Block_header.t.protocol_data
block)) proof_of_work_threshold then
return_unit
else
fail Tezos_protocol_environment_alpha__Environment.Error_monad.Invalid_stamp.
Definition check_signature
(block : Tezos_raw_protocol_alpha.Alpha_context.Block_header.t)
(chain_id : Tezos_protocol_environment_alpha__Environment.Chain_id.t)
(key : Tezos_protocol_environment_alpha__Environment.Signature.Public_key.t)
: Tezos_protocol_environment_alpha__Environment.Lwt.t
(Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult unit) :=
let check_signature
(key : Tezos_protocol_environment_alpha__Environment.Signature.Public_key.t)
(function_parameter : Tezos_raw_protocol_alpha.Alpha_context.Block_header.t)
: bool :=
let '{|
Tezos_raw_protocol_alpha.Alpha_context.Block_header.t.shell := shell;
Tezos_raw_protocol_alpha.Alpha_context.Block_header.t.protocol_data :=
{|
Tezos_raw_protocol_alpha.Alpha_context.Block_header.protocol_data.contents
:= contents;
Tezos_raw_protocol_alpha.Alpha_context.Block_header.protocol_data.signature
:= signature
|}
|} := function_parameter in
let unsigned_header :=
Data_encoding.Binary.to_bytes_exn Block_header.unsigned_encoding
(shell, contents) in
Signature.check
(Some
(Tezos_protocol_environment_alpha__Environment.Signature.Block_header
chain_id)) key signature unsigned_header in
if check_signature key block then
return_unit
else
fail
(Tezos_protocol_environment_alpha__Environment.Error_monad.Invalid_block_signature
(Block_header.__hash_value block)
(Signature.Public_key.__hash_value key)).
Definition max_fitness_gap {A : Set} (_ctxt : A) : int64 :=
(* ❌ Constant of type int64 is converted to int *)
1.
Definition check_fitness_gap
(ctxt : Tezos_raw_protocol_alpha__Alpha_context.context)
(block : Tezos_raw_protocol_alpha.Alpha_context.Block_header.t)
: Tezos_protocol_environment_alpha__Environment.Lwt.t
(Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult unit) :=
let current_fitness := Fitness.current ctxt in
op_gtgteqquestion
(Lwt.__return
(Fitness.to_int64
(Tezos_protocol_environment_alpha__Environment.Block_header.shell_header.fitness
(Tezos_raw_protocol_alpha.Alpha_context.Block_header.t.shell block))))
(fun announced_fitness =>
let gap := Int64.sub announced_fitness current_fitness in
if
op_pipepipe
(op_lteq gap
(* ❌ Constant of type int64 is converted to int *)
0) (op_lt (max_fitness_gap ctxt) gap) then
fail
(Tezos_protocol_environment_alpha__Environment.Error_monad.Invalid_fitness_gap
(max_fitness_gap ctxt) gap)
else
return_unit).
Definition last_of_a_cycle
(ctxt : Tezos_raw_protocol_alpha__Alpha_context.context)
(l : Tezos_raw_protocol_alpha.Alpha_context.Level.t) : bool :=
op_eq
(Int32.succ
(Tezos_raw_protocol_alpha.Alpha_context.Level.t.cycle_position l))
(Constants.blocks_per_cycle ctxt).
Definition dawn_of_a_new_cycle
(ctxt : Tezos_raw_protocol_alpha__Alpha_context.context)
: Tezos_protocol_environment_alpha__Environment.Lwt.t
(Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
(option Tezos_raw_protocol_alpha__Alpha_context.Cycle.t)) :=
let level := Level.current ctxt in
if last_of_a_cycle ctxt level then
return_some (Tezos_raw_protocol_alpha.Alpha_context.Level.t.cycle level)
else
return_none.
Definition minimum_allowed_endorsements
(ctxt : Tezos_raw_protocol_alpha__Alpha_context.context)
(block_delay : Tezos_raw_protocol_alpha.Alpha_context.Period.period)
: Tezos_protocol_environment_alpha__Environment.Compare.Int.t :=
let minimum := Constants.initial_endorsers ctxt in
let delay_per_missing_endorsement :=
Int64.to_int
(Period.to_seconds (Constants.delay_per_missing_endorsement ctxt)) in
let reduced_time_constraint :=
let delay := Int64.to_int (Period.to_seconds block_delay) in
if op_eq delay_per_missing_endorsement 0 then
delay
else
op_div delay delay_per_missing_endorsement in
Compare.Int.max 0 (op_minus minimum reduced_time_constraint).
Definition minimal_valid_time
(ctxt : Tezos_raw_protocol_alpha__Alpha_context.context) (priority : Z)
(endorsing_power : Z)
: Tezos_protocol_environment_alpha__Environment.Lwt.t
(Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
Tezos_protocol_environment_alpha__Environment.Time.t) :=
let predecessor_timestamp := Timestamp.current ctxt in
op_gtgteqquestion (minimal_time ctxt priority predecessor_timestamp)
(fun minimal_time =>
let minimal_required_endorsements := Constants.initial_endorsers ctxt in
let delay_per_missing_endorsement :=
Constants.delay_per_missing_endorsement ctxt in
let missing_endorsements :=
Compare.Int.max 0
(op_minus minimal_required_endorsements endorsing_power) in
match
Period.mult (Int32.of_int missing_endorsements)
delay_per_missing_endorsement with
| Tezos_protocol_environment_alpha__Environment.Pervasives.Ok delay =>
__return (Time.add minimal_time (Period.to_seconds delay))
|
(Tezos_protocol_environment_alpha__Environment.Pervasives.Error _) as
err => Lwt.__return err
end).
baking.mli 7 errors
(*****************************************************************************)
(* *)
(* Open Source License *)
(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com> *)
(* *)
(* Permission is hereby granted, free of charge, to any person obtaining a *)
(* copy of this software and associated documentation files (the "Software"),*)
(* to deal in the Software without restriction, including without limitation *)
(* the rights to use, copy, modify, merge, publish, distribute, sublicense, *)
(* and/or sell copies of the Software, and to permit persons to whom the *)
(* Software is furnished to do so, subject to the following conditions: *)
(* *)
(* The above copyright notice and this permission notice shall be included *)
(* in all copies or substantial portions of the Software. *)
(* *)
(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*)
(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, *)
(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL *)
(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*)
(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING *)
(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER *)
(* DEALINGS IN THE SOFTWARE. *)
(* *)
(*****************************************************************************)
open Alpha_context
open Misc
type error += Invalid_fitness_gap of int64 * int64 (* `Permanent *)
type error += Timestamp_too_early of Timestamp.t * Timestamp.t
(* `Permanent *)
type error +=
| Invalid_block_signature of Block_hash.t * Signature.Public_key_hash.t
(* `Permanent *)
type error += Unexpected_endorsement
type error += Invalid_signature (* `Permanent *)
type error += Invalid_stamp (* `Permanent *)
(** [minimal_time ctxt priority pred_block_time] returns the minimal
time, given the predecessor block timestamp [pred_block_time],
after which a baker with priority [priority] is allowed to
bake. Fail with [Invalid_time_between_blocks_constant] if the minimal
time cannot be computed. *)
val minimal_time : context -> int -> Time.t -> Time.t tzresult Lwt.t
(** [check_baking_rights ctxt block pred_timestamp] verifies that:
* the contract that owned the roll at cycle start has the block signer as delegate.
* the timestamp is coherent with the announced slot.
*)
val check_baking_rights :
context ->
Block_header.contents ->
Time.t ->
(public_key * Period.t) tzresult Lwt.t
(** For a given level computes who has the right to
include an endorsement in the next block.
The result can be stored in Alpha_context.allowed_endorsements *)
val endorsement_rights :
context ->
Level.t ->
(public_key * int list * bool) Signature.Public_key_hash.Map.t tzresult Lwt.t
(** Check that the operation was signed by a delegate allowed
to endorse at the level specified by the endorsement. *)
val check_endorsement_rights :
context ->
Chain_id.t ->
Kind.endorsement Operation.t ->
(public_key_hash * int list * bool) tzresult Lwt.t
(** Returns the baking reward calculated w.r.t a given priority [p] and a
number [e] of included endorsements as follows:
(block_reward / (p+1)) * (0.8 + 0.2 * e / endorsers_per_block)
*)
val baking_reward :
context ->
block_priority:int ->
included_endorsements:int ->
Tez.t tzresult Lwt.t
(** Returns the endorsing reward calculated w.r.t a given priority. *)
val endorsing_reward :
context -> block_priority:int -> int -> Tez.t tzresult Lwt.t
(** [baking_priorities ctxt level] is the lazy list of contract's
public key hashes that are allowed to bake for [level]. *)
val baking_priorities : context -> Level.t -> public_key lazy_list
(** [first_baking_priorities ctxt ?max_priority contract_hash level]
is a list of priorities of max [?max_priority] elements, where the
delegate of [contract_hash] is allowed to bake for [level]. If
[?max_priority] is [None], a sensible number of priorities is
returned. *)
val first_baking_priorities :
context ->
?max_priority:int ->
public_key_hash ->
Level.t ->
int list tzresult Lwt.t
(** [check_signature ctxt chain_id block id] check if the block is
signed with the given key, and belongs to the given [chain_id] *)
val check_signature :
Block_header.t -> Chain_id.t -> public_key -> unit tzresult Lwt.t
(** Checks if the header that would be built from the given components
is valid for the given diffculty. The signature is not passed as it
is does not impact the proof-of-work stamp. The stamp is checked on
the hash of a block header whose signature has been zeroed-out. *)
val check_header_proof_of_work_stamp :
Block_header.shell_header -> Block_header.contents -> int64 -> bool
(** verify if the proof of work stamp is valid *)
val check_proof_of_work_stamp :
context -> Block_header.t -> unit tzresult Lwt.t
(** check if the gap between the fitness of the current context
and the given block is within the protocol parameters *)
val check_fitness_gap : context -> Block_header.t -> unit tzresult Lwt.t
val dawn_of_a_new_cycle : context -> Cycle.t option tzresult Lwt.t
val earlier_predecessor_timestamp :
context -> Level.t -> Timestamp.t tzresult Lwt.t
(** Since Emmy+
A block is valid only if its timestamp has a minimal delay with
respect to the previous block's timestamp, and this minimal delay
depends not only on the block's priority but also on the number of
endorsement operations included in the block.
In Emmy+, blocks' fitness increases by one unit with each level.
In this way, Emmy+ simplifies the optimal baking strategy: The
bakers used to have to choose whether to wait for more endorsements
to include in their block, or to publish the block immediately,
without waiting. The incentive for including more endorsements was
to increase the fitness and win against unknown blocks. However,
when a block was produced too late in the priority period, there
was the risk that the block did not reach endorsers before the
block of next priority. In Emmy+, the baker does not need to take
such a decision, because the baker cannot publish a block too
early. *)
(** Given a delay of a block's timestamp with respect to the minimum
time to bake at the block's priority (as returned by
`minimum_time`), it returns the minimum number of endorsements that
the block has to contain *)
val minimum_allowed_endorsements : context -> block_delay:Period.t -> int
(** This is the somehow the dual of the previous function. Given a
block priority and a number of endorsement slots (given by the
`endorsing_power` argument), it returns the minimum time at which
the next block can be baked. *)
val minimal_valid_time :
context -> priority:int -> endorsing_power:int -> Time.t tzresult Lwt.t
baking_mli.v
Require Import OCaml.OCaml.
Local Open Scope Z_scope.
Local Open Scope type_scope.
Import ListNotations.
(* extensible_type Tezos_protocol_environment_alpha__Environment.Error_monad.error *)
(* extensible_type Tezos_protocol_environment_alpha__Environment.Error_monad.error *)
(* extensible_type Tezos_protocol_environment_alpha__Environment.Error_monad.error *)
(* extensible_type Tezos_protocol_environment_alpha__Environment.Error_monad.error *)
(* extensible_type Tezos_protocol_environment_alpha__Environment.Error_monad.error *)
(* extensible_type Tezos_protocol_environment_alpha__Environment.Error_monad.error *)
Parameter minimal_time :
Tezos_raw_protocol_alpha.Alpha_context.context -> Z ->
Tezos_protocol_environment_alpha__Environment.Time.t ->
Tezos_protocol_environment_alpha__Environment.Lwt.t
(Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
Tezos_protocol_environment_alpha__Environment.Time.t).
Parameter check_baking_rights :
Tezos_raw_protocol_alpha.Alpha_context.context ->
Tezos_raw_protocol_alpha.Alpha_context.Block_header.contents ->
Tezos_protocol_environment_alpha__Environment.Time.t ->
Tezos_protocol_environment_alpha__Environment.Lwt.t
(Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
(Tezos_raw_protocol_alpha.Alpha_context.public_key *
Tezos_raw_protocol_alpha.Alpha_context.Period.t)).
Parameter endorsement_rights :
Tezos_raw_protocol_alpha.Alpha_context.context ->
Tezos_raw_protocol_alpha.Alpha_context.Level.t ->
Tezos_protocol_environment_alpha__Environment.Lwt.t
(Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
(Tezos_protocol_environment_alpha__Environment.Signature.Public_key_hash.Map.t
(Tezos_raw_protocol_alpha.Alpha_context.public_key * list Z * bool))).
Parameter check_endorsement_rights :
Tezos_raw_protocol_alpha.Alpha_context.context ->
Tezos_protocol_environment_alpha__Environment.Chain_id.t ->
Tezos_raw_protocol_alpha.Alpha_context.Operation.t
Tezos_raw_protocol_alpha.Alpha_context.Kind.endorsement ->
Tezos_protocol_environment_alpha__Environment.Lwt.t
(Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
(Tezos_raw_protocol_alpha.Alpha_context.public_key_hash * list Z * bool)).
Parameter baking_reward :
Tezos_raw_protocol_alpha.Alpha_context.context -> Z -> Z ->
Tezos_protocol_environment_alpha__Environment.Lwt.t
(Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
Tezos_raw_protocol_alpha.Alpha_context.Tez.t).
Parameter endorsing_reward :
Tezos_raw_protocol_alpha.Alpha_context.context -> Z -> Z ->
Tezos_protocol_environment_alpha__Environment.Lwt.t
(Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
Tezos_raw_protocol_alpha.Alpha_context.Tez.t).
Parameter baking_priorities :
Tezos_raw_protocol_alpha.Alpha_context.context ->
Tezos_raw_protocol_alpha.Alpha_context.Level.t ->
Tezos_raw_protocol_alpha.Misc.lazy_list
Tezos_raw_protocol_alpha.Alpha_context.public_key.
Parameter first_baking_priorities :
Tezos_raw_protocol_alpha.Alpha_context.context -> option Z ->
Tezos_raw_protocol_alpha.Alpha_context.public_key_hash ->
Tezos_raw_protocol_alpha.Alpha_context.Level.t ->
Tezos_protocol_environment_alpha__Environment.Lwt.t
(Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult (list Z)).
Parameter check_signature :
Tezos_raw_protocol_alpha.Alpha_context.Block_header.t ->
Tezos_protocol_environment_alpha__Environment.Chain_id.t ->
Tezos_raw_protocol_alpha.Alpha_context.public_key ->
Tezos_protocol_environment_alpha__Environment.Lwt.t
(Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult unit).
Parameter check_header_proof_of_work_stamp :
Tezos_raw_protocol_alpha.Alpha_context.Block_header.shell_header ->
Tezos_raw_protocol_alpha.Alpha_context.Block_header.contents -> int64 -> bool.
Parameter check_proof_of_work_stamp :
Tezos_raw_protocol_alpha.Alpha_context.context ->
Tezos_raw_protocol_alpha.Alpha_context.Block_header.t ->
Tezos_protocol_environment_alpha__Environment.Lwt.t
(Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult unit).
Parameter check_fitness_gap :
Tezos_raw_protocol_alpha.Alpha_context.context ->
Tezos_raw_protocol_alpha.Alpha_context.Block_header.t ->
Tezos_protocol_environment_alpha__Environment.Lwt.t
(Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult unit).
Parameter dawn_of_a_new_cycle :
Tezos_raw_protocol_alpha.Alpha_context.context ->
Tezos_protocol_environment_alpha__Environment.Lwt.t
(Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
(option Tezos_raw_protocol_alpha.Alpha_context.Cycle.t)).
Parameter earlier_predecessor_timestamp :
Tezos_raw_protocol_alpha.Alpha_context.context ->
Tezos_raw_protocol_alpha.Alpha_context.Level.t ->
Tezos_protocol_environment_alpha__Environment.Lwt.t
(Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
Tezos_raw_protocol_alpha.Alpha_context.Timestamp.t).
Parameter minimum_allowed_endorsements :
Tezos_raw_protocol_alpha.Alpha_context.context ->
Tezos_raw_protocol_alpha.Alpha_context.Period.t -> Z.
Parameter minimal_valid_time :
Tezos_raw_protocol_alpha.Alpha_context.context -> Z -> Z ->
Tezos_protocol_environment_alpha__Environment.Lwt.t
(Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
Tezos_protocol_environment_alpha__Environment.Time.t).
blinded_public_key_hash.ml 5 errors
(*****************************************************************************)
(* *)
(* Open Source License *)
(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com> *)
(* *)
(* Permission is hereby granted, free of charge, to any person obtaining a *)
(* copy of this software and associated documentation files (the "Software"),*)
(* to deal in the Software without restriction, including without limitation *)
(* the rights to use, copy, modify, merge, publish, distribute, sublicense, *)
(* and/or sell copies of the Software, and to permit persons to whom the *)
(* Software is furnished to do so, subject to the following conditions: *)
(* *)
(* The above copyright notice and this permission notice shall be included *)
(* in all copies or substantial portions of the Software. *)
(* *)
(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*)
(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, *)
(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL *)
(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*)
(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING *)
(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER *)
(* DEALINGS IN THE SOFTWARE. *)
(* *)
(*****************************************************************************)
module H =
Blake2B.Make
(Base58)
(struct
let name = "Blinded public key hash"
let title = "A blinded public key hash"
let b58check_prefix = "\001\002\049\223"
let size = Some Ed25519.Public_key_hash.size
end)
include H
let () = Base58.check_encoded_prefix b58check_encoding "btz1" 37
let of_ed25519_pkh activation_code pkh =
hash_bytes ~key:activation_code [Ed25519.Public_key_hash.to_bytes pkh]
type activation_code = MBytes.t
let activation_code_size = Ed25519.Public_key_hash.size
let activation_code_encoding = Data_encoding.Fixed.bytes activation_code_size
let activation_code_of_hex h =
if Compare.Int.(String.length h <> activation_code_size * 2) then
invalid_arg "Blinded_public_key_hash.activation_code_of_hex" ;
MBytes.of_hex (`Hex h)
module Index = H
blinded_public_key_hash_ml.v
Require Import OCaml.OCaml.
Local Open Scope Z_scope.
Local Open Scope type_scope.
Import ListNotations.
(* ❌ Applications of functors are not handled. *)
functor_application
Export H.
(* ❌ Top-level evaluations are considered as an error as sources of side-effects *)
Compute Base58.check_encoded_prefix b58check_encoding "btz1" % string 37.
Definition of_ed25519_pkh
(activation_code : Tezos_protocol_environment_alpha__Environment.MBytes.t)
(pkh : Tezos_protocol_environment_alpha__Environment.Ed25519.Public_key_hash.t)
: t :=
hash_bytes (Some activation_code)
(cons (Ed25519.Public_key_hash.to_bytes pkh) []).
Definition activation_code :=
Tezos_protocol_environment_alpha__Environment.MBytes.t.
Definition activation_code_size : Z := Ed25519.Public_key_hash.size.
Definition activation_code_encoding
: Tezos_protocol_environment_alpha__Environment.Data_encoding.encoding
Tezos_protocol_environment_alpha__Environment.MBytes.t :=
Data_encoding.Fixed.__bytes_value activation_code_size.
Definition activation_code_of_hex (h : string)
: Tezos_protocol_environment_alpha__Environment.MBytes.t :=
(* ❌ Sequences of instructions are not handled (operator ";") *)
let _ :=
if op_ltgt (String.length h) (op_star activation_code_size 2) then
invalid_arg "Blinded_public_key_hash.activation_code_of_hex" % string
else
tt in
MBytes.of_hex
(* ❌ Variants not supported *)
variant.
Module Index := H.
blinded_public_key_hash.mli 2 errors
(*****************************************************************************) (* *) (* Open Source License *) (* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com> *) (* *) (* Permission is hereby granted, free of charge, to any person obtaining a *) (* copy of this software and associated documentation files (the "Software"),*) (* to deal in the Software without restriction, including without limitation *) (* the rights to use, copy, modify, merge, publish, distribute, sublicense, *) (* and/or sell copies of the Software, and to permit persons to whom the *) (* Software is furnished to do so, subject to the following conditions: *) (* *) (* The above copyright notice and this permission notice shall be included *) (* in all copies or substantial portions of the Software. *) (* *) (* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*) (* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, *) (* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL *) (* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*) (* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING *) (* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER *) (* DEALINGS IN THE SOFTWARE. *) (* *) (*****************************************************************************) include S.HASH val encoding : t Data_encoding.t val rpc_arg : t RPC_arg.t type activation_code val activation_code_encoding : activation_code Data_encoding.t val of_ed25519_pkh : activation_code -> Ed25519.Public_key_hash.t -> t val activation_code_of_hex : string -> activation_code module Index : Storage_description.INDEX with type t = t
blinded_public_key_hash_mli.v
Require Import OCaml.OCaml.
Local Open Scope Z_scope.
Local Open Scope type_scope.
Import ListNotations.
Parameter t : Set.
Parameter name : string.
Parameter title : string.
Parameter pp :
Tezos_protocol_environment_alpha__Environment.Format.formatter -> t -> unit.
Parameter pp_short :
Tezos_protocol_environment_alpha__Environment.Format.formatter -> t -> unit.
Parameter op_eq : t -> t -> bool.
Parameter op_ltgt : t -> t -> bool.
Parameter op_lt : t -> t -> bool.
Parameter op_lteq : t -> t -> bool.
Parameter op_gteq : t -> t -> bool.
Parameter op_gt : t -> t -> bool.
Parameter compare : t -> t -> Z.
Parameter equal : t -> t -> bool.
Parameter max : t -> t -> t.
Parameter min : t -> t -> t.
Parameter hash_bytes :
option Tezos_protocol_environment_alpha__Environment.MBytes.t ->
list Tezos_protocol_environment_alpha__Environment.MBytes.t -> t.
Parameter hash_string : option string -> list string -> t.
Parameter zero : t.
Parameter size : Z.
Parameter to_bytes :
t -> Tezos_protocol_environment_alpha__Environment.MBytes.t.
Parameter of_bytes_opt :
Tezos_protocol_environment_alpha__Environment.MBytes.t -> option t.
Parameter of_bytes_exn :
Tezos_protocol_environment_alpha__Environment.MBytes.t -> t.
Parameter to_b58check : t -> string.
Parameter to_short_b58check : t -> string.
Parameter of_b58check_exn : string -> t.
Parameter of_b58check_opt : string -> option t.
(* extensible_type Tezos_protocol_environment_alpha__Environment.Base58.data *)
Parameter b58check_encoding :
Tezos_protocol_environment_alpha__Environment.Base58.encoding t.
Parameter encoding :
Tezos_protocol_environment_alpha__Environment.Data_encoding.t t.
Parameter rpc_arg : Tezos_protocol_environment_alpha__Environment.RPC_arg.t t.
Parameter to_path : t -> list string -> list string.
Parameter of_path : list string -> option t.
Parameter of_path_exn : list string -> t.
Parameter prefix_path : string -> list string.
Parameter path_length : Z.
Module __Set.
Definition elt := t.
Parameter t : Set.
Parameter empty : t.
Parameter is_empty : t -> bool.
Parameter mem : elt -> t -> bool.
Parameter add : elt -> t -> t.
Parameter singleton : elt -> t.
Parameter remove : elt -> t -> t.
Parameter union : t -> t -> t.
Parameter inter : t -> t -> t.
Parameter diff : t -> t -> t.
Parameter compare : t -> t -> Z.
Parameter equal : t -> t -> bool.
Parameter subset : t -> t -> bool.
Parameter iter : (elt -> unit) -> t -> unit.
Parameter map : (elt -> elt) -> t -> t.
Parameter fold : forall {a : Set}, (elt -> a -> a) -> t -> a -> a.
Parameter for_all : (elt -> bool) -> t -> bool.
Parameter __exists : (elt -> bool) -> t -> bool.
Parameter filter : (elt -> bool) -> t -> t.
Parameter partition : (elt -> bool) -> t -> t * t.
Parameter cardinal : t -> Z.
Parameter elements : t -> list elt.
Parameter min_elt : t -> elt.
Parameter min_elt_opt : t -> option elt.
Parameter max_elt : t -> elt.
Parameter max_elt_opt : t -> option elt.
Parameter choose : t -> elt.
Parameter choose_opt : t -> option elt.
Parameter split : elt -> t -> t * bool * t.
Parameter find : elt -> t -> elt.
Parameter find_opt : elt -> t -> option elt.
Parameter find_first : (elt -> bool) -> t -> elt.
Parameter find_first_opt : (elt -> bool) -> t -> option elt.
Parameter find_last : (elt -> bool) -> t -> elt.
Parameter find_last_opt : (elt -> bool) -> t -> option elt.
Parameter of_list : list elt -> t.
Parameter to_seq_from : elt -> t -> OCaml.Seq.t elt.
Parameter to_seq : t -> OCaml.Seq.t elt.
Parameter add_seq : OCaml.Seq.t elt -> t -> t.
Parameter of_seq : OCaml.Seq.t elt -> t.
Parameter encoding :
Tezos_protocol_environment_alpha__Environment.Data_encoding.t t.
End __Set.
Module Map.
Definition key := t.
Parameter t : forall (a : Set), Set.
Parameter empty : forall {a : Set}, t a.
Parameter is_empty : forall {a : Set}, t a -> bool.
Parameter mem : forall {a : Set}, key -> t a -> bool.
Parameter add : forall {a : Set}, key -> a -> t a -> t a.
Parameter update : forall {a : Set},
key -> (option a -> option a) -> t a -> t a.
Parameter singleton : forall {a : Set}, key -> a -> t a.
Parameter remove : forall {a : Set}, key -> t a -> t a.
Parameter merge : forall {a b c : Set},
(key -> option a -> option b -> option c) -> t a -> t b -> t c.
Parameter union : forall {a : Set},
(key -> a -> a -> option a) -> t a -> t a -> t a.
Parameter compare : forall {a : Set}, (a -> a -> Z) -> t a -> t a -> Z.
Parameter equal : forall {a : Set}, (a -> a -> bool) -> t a -> t a -> bool.
Parameter iter : forall {a : Set}, (key -> a -> unit) -> t a -> unit.
Parameter fold : forall {a b : Set}, (key -> a -> b -> b) -> t a -> b -> b.
Parameter for_all : forall {a : Set}, (key -> a -> bool) -> t a -> bool.
Parameter __exists : forall {a : Set}, (key -> a -> bool) -> t a -> bool.
Parameter filter : forall {a : Set}, (key -> a -> bool) -> t a -> t a.
Parameter partition : forall {a : Set},
(key -> a -> bool) -> t a -> t a * t a.
Parameter cardinal : forall {a : Set}, t a -> Z.
Parameter bindings : forall {a : Set}, t a -> list (key * a).
Parameter min_binding : forall {a : Set}, t a -> key * a.
Parameter min_binding_opt : forall {a : Set}, t a -> option (key * a).
Parameter max_binding : forall {a : Set}, t a -> key * a.
Parameter max_binding_opt : forall {a : Set}, t a -> option (key * a).
Parameter choose : forall {a : Set}, t a -> key * a.
Parameter choose_opt : forall {a : Set}, t a -> option (key * a).
Parameter split : forall {a : Set}, key -> t a -> t a * option a * t a.
Parameter find : forall {a : Set}, key -> t a -> a.
Parameter find_opt : forall {a : Set}, key -> t a -> option a.
Parameter find_first : forall {a : Set}, (key -> bool) -> t a -> key * a.
Parameter find_first_opt : forall {a : Set},
(key -> bool) -> t a -> option (key * a).
Parameter find_last : forall {a : Set}, (key -> bool) -> t a -> key * a.
Parameter find_last_opt : forall {a : Set},
(key -> bool) -> t a -> option (key * a).
Parameter map : forall {a b : Set}, (a -> b) -> t a -> t b.
Parameter mapi : forall {a b : Set}, (key -> a -> b) -> t a -> t b.
Parameter to_seq : forall {a : Set}, t a -> OCaml.Seq.t (key * a).
Parameter to_seq_from : forall {a : Set}, key -> t a -> OCaml.Seq.t (key * a).
Parameter add_seq : forall {a : Set}, OCaml.Seq.t (key * a) -> t a -> t a.
Parameter of_seq : forall {a : Set}, OCaml.Seq.t (key * a) -> t a.
Parameter encoding : forall {a : Set},
Tezos_protocol_environment_alpha__Environment.Data_encoding.t a ->
Tezos_protocol_environment_alpha__Environment.Data_encoding.t (t a).
End Map.
Parameter encoding :
Tezos_protocol_environment_alpha__Environment.Data_encoding.t t.
Parameter rpc_arg : Tezos_protocol_environment_alpha__Environment.RPC_arg.t t.
Parameter activation_code : Set.
Parameter activation_code_encoding :
Tezos_protocol_environment_alpha__Environment.Data_encoding.t activation_code.
Parameter of_ed25519_pkh :
activation_code ->
Tezos_protocol_environment_alpha__Environment.Ed25519.Public_key_hash.t -> t.
Parameter activation_code_of_hex : string -> activation_code.
Module Index.
Definition t := t.
Parameter path_length : Z.
Parameter to_path : t -> list string -> list string.
Parameter of_path : list string -> option t.
Parameter rpc_arg : Tezos_protocol_environment_alpha__Environment.RPC_arg.t t.
Parameter encoding :
Tezos_protocol_environment_alpha__Environment.Data_encoding.t t.
Parameter compare : t -> t -> Z.
End Index.
block_header_repr.ml 1 error
(*****************************************************************************)
(* *)
(* Open Source License *)
(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com> *)
(* *)
(* Permission is hereby granted, free of charge, to any person obtaining a *)
(* copy of this software and associated documentation files (the "Software"),*)
(* to deal in the Software without restriction, including without limitation *)
(* the rights to use, copy, modify, merge, publish, distribute, sublicense, *)
(* and/or sell copies of the Software, and to permit persons to whom the *)
(* Software is furnished to do so, subject to the following conditions: *)
(* *)
(* The above copyright notice and this permission notice shall be included *)
(* in all copies or substantial portions of the Software. *)
(* *)
(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*)
(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, *)
(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL *)
(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*)
(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING *)
(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER *)
(* DEALINGS IN THE SOFTWARE. *)
(* *)
(*****************************************************************************)
(** Block header *)
type t = {shell : Block_header.shell_header; protocol_data : protocol_data}
and protocol_data = {contents : contents; signature : Signature.t}
and contents = {
priority : int;
seed_nonce_hash : Nonce_hash.t option;
proof_of_work_nonce : MBytes.t;
}
type block_header = t
type raw = Block_header.t
type shell_header = Block_header.shell_header
let raw_encoding = Block_header.encoding
let shell_header_encoding = Block_header.shell_header_encoding
let contents_encoding =
let open Data_encoding in
def "block_header.alpha.unsigned_contents"
@@ conv
(fun {priority; seed_nonce_hash; proof_of_work_nonce} ->
(priority, proof_of_work_nonce, seed_nonce_hash))
(fun (priority, proof_of_work_nonce, seed_nonce_hash) ->
{priority; seed_nonce_hash; proof_of_work_nonce})
(obj3
(req "priority" uint16)
(req
"proof_of_work_nonce"
(Fixed.bytes Constants_repr.proof_of_work_nonce_size))
(opt "seed_nonce_hash" Nonce_hash.encoding))
let protocol_data_encoding =
let open Data_encoding in
def "block_header.alpha.signed_contents"
@@ conv
(fun {contents; signature} -> (contents, signature))
(fun (contents, signature) -> {contents; signature})
(merge_objs
contents_encoding
(obj1 (req "signature" Signature.encoding)))
let raw {shell; protocol_data} =
let protocol_data =
Data_encoding.Binary.to_bytes_exn protocol_data_encoding protocol_data
in
{Block_header.shell; protocol_data}
let unsigned_encoding =
let open Data_encoding in
merge_objs Block_header.shell_header_encoding contents_encoding
let encoding =
let open Data_encoding in
def "block_header.alpha.full_header"
@@ conv
(fun {shell; protocol_data} -> (shell, protocol_data))
(fun (shell, protocol_data) -> {shell; protocol_data})
(merge_objs Block_header.shell_header_encoding protocol_data_encoding)
(** Constants *)
let max_header_length =
let fake_shell =
{
Block_header.level = 0l;
proto_level = 0;
predecessor = Block_hash.zero;
timestamp = Time.of_seconds 0L;
validation_passes = 0;
operations_hash = Operation_list_list_hash.zero;
fitness = Fitness_repr.from_int64 0L;
context = Context_hash.zero;
}
and fake_contents =
{
priority = 0;
proof_of_work_nonce =
MBytes.create Constants_repr.proof_of_work_nonce_size;
seed_nonce_hash = Some Nonce_hash.zero;
}
in
Data_encoding.Binary.length
encoding
{
shell = fake_shell;
protocol_data = {contents = fake_contents; signature = Signature.zero};
}
(** Header parsing entry point *)
let hash_raw = Block_header.hash
let hash {shell; protocol_data} =
Block_header.hash
{
shell;
protocol_data =
Data_encoding.Binary.to_bytes_exn protocol_data_encoding protocol_data;
}
block_header_repr_ml.v
Require Import OCaml.OCaml.
Local Open Scope Z_scope.
Local Open Scope type_scope.
Import ListNotations.
Reserved Notation "'t".
Reserved Notation "'protocol_data".
Reserved Notation "'contents".
Module contents_skeleton.
Record record {priority seed_nonce_hash proof_of_work_nonce : Set} := {
priority : priority;
seed_nonce_hash : seed_nonce_hash;
proof_of_work_nonce : proof_of_work_nonce }.
Arguments record : clear implicits.
End contents_skeleton.
Definition contents_skeleton := contents_skeleton.record.
Module protocol_data_skeleton.
Record record {contents signature : Set} := {
contents : contents;
signature : signature }.
Arguments record : clear implicits.
End protocol_data_skeleton.
Definition protocol_data_skeleton := protocol_data_skeleton.record.
Module t_skeleton.
Record record {shell protocol_data : Set} := {
shell : shell;
protocol_data : protocol_data }.
Arguments record : clear implicits.
End t_skeleton.
Definition t_skeleton := t_skeleton.record.
where "'t" :=
(t_skeleton
Tezos_protocol_environment_alpha__Environment.Block_header.shell_header
'protocol_data)
and "'protocol_data" :=
(protocol_data_skeleton 'contents
Tezos_protocol_environment_alpha__Environment.Signature.t)
and "'contents" :=
(contents_skeleton Z (option Tezos_raw_protocol_alpha.Nonce_hash.t)
Tezos_protocol_environment_alpha__Environment.MBytes.t).
Definition t := 't.
Definition protocol_data := 'protocol_data.
Definition contents := 'contents.
Definition block_header := t.
Definition raw := Tezos_protocol_environment_alpha__Environment.Block_header.t.
Definition shell_header :=
Tezos_protocol_environment_alpha__Environment.Block_header.shell_header.
Definition raw_encoding
: Tezos_protocol_environment_alpha__Environment.Data_encoding.t
Tezos_protocol_environment_alpha__Environment.Block_header.t :=
Block_header.encoding.
Definition shell_header_encoding
: Tezos_protocol_environment_alpha__Environment.Data_encoding.t
Tezos_protocol_environment_alpha__Environment.Block_header.shell_header :=
Block_header.shell_header_encoding.
Definition contents_encoding
: Tezos_protocol_environment_alpha__Environment.Data_encoding.encoding
contents :=
op_atat
(let arg := def "block_header.alpha.unsigned_contents" % string in
fun eta => arg None None eta)
(conv
(fun function_parameter =>
let '{|
contents.priority := priority;
contents.seed_nonce_hash := seed_nonce_hash;
contents.proof_of_work_nonce := proof_of_work_nonce
|} := function_parameter in
(priority, proof_of_work_nonce, seed_nonce_hash))
(fun function_parameter =>
let '(priority, proof_of_work_nonce, seed_nonce_hash) :=
function_parameter in
{| contents.priority := priority;
contents.seed_nonce_hash := seed_nonce_hash;
contents.proof_of_work_nonce := proof_of_work_nonce |}) None
(obj3 (req None None "priority" % string uint16)
(req None None "proof_of_work_nonce" % string
(Fixed.__bytes_value Constants_repr.proof_of_work_nonce_size))
(opt None None "seed_nonce_hash" % string Nonce_hash.encoding))).
Definition protocol_data_encoding
: Tezos_protocol_environment_alpha__Environment.Data_encoding.encoding
protocol_data :=
op_atat
(let arg := def "block_header.alpha.signed_contents" % string in
fun eta => arg None None eta)
(conv
(fun function_parameter =>
let '{|
protocol_data.contents := contents;
protocol_data.signature := signature
|} := function_parameter in
(contents, signature))
(fun function_parameter =>
let '(contents, signature) := function_parameter in
{| protocol_data.contents := contents;
protocol_data.signature := signature |}) None
(merge_objs contents_encoding
(obj1 (req None None "signature" % string Signature.encoding)))).
Definition raw (function_parameter : t)
: Tezos_protocol_environment_alpha__Environment.Block_header.t :=
let '{| t.shell := shell; t.protocol_data := protocol_data |} :=
function_parameter in
let protocol_data :=
Data_encoding.Binary.to_bytes_exn protocol_data_encoding protocol_data in
{|
Tezos_protocol_environment_alpha__Environment.Block_header.t.shell := shell;
Tezos_protocol_environment_alpha__Environment.Block_header.t.protocol_data :=
protocol_data |}.
Definition unsigned_encoding
: Tezos_protocol_environment_alpha__Environment.Data_encoding.encoding
(Tezos_protocol_environment_alpha__Environment.Block_header.shell_header *
contents) :=
merge_objs Block_header.shell_header_encoding contents_encoding.
Definition encoding
: Tezos_protocol_environment_alpha__Environment.Data_encoding.encoding t :=
op_atat
(let arg := def "block_header.alpha.full_header" % string in
fun eta => arg None None eta)
(conv
(fun function_parameter =>
let '{| t.shell := shell; t.protocol_data := protocol_data |} :=
function_parameter in
(shell, protocol_data))
(fun function_parameter =>
let '(shell, protocol_data) := function_parameter in
{| t.shell := shell; t.protocol_data := protocol_data |}) None
(merge_objs Block_header.shell_header_encoding protocol_data_encoding)).
Definition max_header_length : Z :=
let fake_shell
: Tezos_protocol_environment_alpha__Environment.Block_header.shell_header :=
{|
Tezos_protocol_environment_alpha__Environment.Block_header.shell_header.level :=
(* ❌ Constant of type int32 is converted to int *)
0;
Tezos_protocol_environment_alpha__Environment.Block_header.shell_header.proto_level :=
0;
Tezos_protocol_environment_alpha__Environment.Block_header.shell_header.predecessor :=
Block_hash.zero;
Tezos_protocol_environment_alpha__Environment.Block_header.shell_header.timestamp :=
Time.of_seconds
(* ❌ Constant of type int64 is converted to int *)
0;
Tezos_protocol_environment_alpha__Environment.Block_header.shell_header.validation_passes :=
0;
Tezos_protocol_environment_alpha__Environment.Block_header.shell_header.operations_hash :=
Operation_list_list_hash.zero;
Tezos_protocol_environment_alpha__Environment.Block_header.shell_header.fitness :=
Fitness_repr.from_int64
(* ❌ Constant of type int64 is converted to int *)
0;
Tezos_protocol_environment_alpha__Environment.Block_header.shell_header.context :=
Context_hash.zero |}
with fake_contents : contents :=
{| contents.priority := 0; contents.seed_nonce_hash := Some Nonce_hash.zero;
contents.proof_of_work_nonce :=
MBytes.create Constants_repr.proof_of_work_nonce_size |} in
Data_encoding.Binary.length encoding
{| t.shell := fake_shell;
t.protocol_data :=
{| protocol_data.contents := fake_contents;
protocol_data.signature := Signature.zero |} |}.
Definition hash_raw
: Tezos_protocol_environment_alpha__Environment.Block_header.t ->
Tezos_protocol_environment_alpha__Environment.Block_hash.t :=
Block_header.__hash_value.
Definition __hash_value (function_parameter : t)
: Tezos_protocol_environment_alpha__Environment.Block_hash.t :=
let '{| t.shell := shell; t.protocol_data := protocol_data |} :=
function_parameter in
Block_header.__hash_value
{|
Tezos_protocol_environment_alpha__Environment.Block_header.t.shell :=
shell;
Tezos_protocol_environment_alpha__Environment.Block_header.t.protocol_data :=
Data_encoding.Binary.to_bytes_exn protocol_data_encoding protocol_data
|}.
block_header_repr.mli 1 error
(*****************************************************************************)
(* *)
(* Open Source License *)
(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com> *)
(* *)
(* Permission is hereby granted, free of charge, to any person obtaining a *)
(* copy of this software and associated documentation files (the "Software"),*)
(* to deal in the Software without restriction, including without limitation *)
(* the rights to use, copy, modify, merge, publish, distribute, sublicense, *)
(* and/or sell copies of the Software, and to permit persons to whom the *)
(* Software is furnished to do so, subject to the following conditions: *)
(* *)
(* The above copyright notice and this permission notice shall be included *)
(* in all copies or substantial portions of the Software. *)
(* *)
(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*)
(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, *)
(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL *)
(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*)
(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING *)
(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER *)
(* DEALINGS IN THE SOFTWARE. *)
(* *)
(*****************************************************************************)
type t = {shell : Block_header.shell_header; protocol_data : protocol_data}
and protocol_data = {contents : contents; signature : Signature.t}
and contents = {
priority : int;
seed_nonce_hash : Nonce_hash.t option;
proof_of_work_nonce : MBytes.t;
}
type block_header = t
type raw = Block_header.t
type shell_header = Block_header.shell_header
val raw : block_header -> raw
val encoding : block_header Data_encoding.encoding
val raw_encoding : raw Data_encoding.t
val contents_encoding : contents Data_encoding.t
val unsigned_encoding : (Block_header.shell_header * contents) Data_encoding.t
val protocol_data_encoding : protocol_data Data_encoding.encoding
val shell_header_encoding : shell_header Data_encoding.encoding
(** The maximum size of block headers in bytes *)
val max_header_length : int
val hash : block_header -> Block_hash.t
val hash_raw : raw -> Block_hash.t
block_header_repr_mli.v
Require Import OCaml.OCaml.
Local Open Scope Z_scope.
Local Open Scope type_scope.
Import ListNotations.
Reserved Notation "'t".
Reserved Notation "'protocol_data".
Reserved Notation "'contents".
Module contents_skeleton.
Record record {priority seed_nonce_hash proof_of_work_nonce : Set} := {
priority : priority;
seed_nonce_hash : seed_nonce_hash;
proof_of_work_nonce : proof_of_work_nonce }.
Arguments record : clear implicits.
End contents_skeleton.
Definition contents_skeleton := contents_skeleton.record.
Module protocol_data_skeleton.
Record record {contents signature : Set} := {
contents : contents;
signature : signature }.
Arguments record : clear implicits.
End protocol_data_skeleton.
Definition protocol_data_skeleton := protocol_data_skeleton.record.
Module t_skeleton.
Record record {shell protocol_data : Set} := {
shell : shell;
protocol_data : protocol_data }.
Arguments record : clear implicits.
End t_skeleton.
Definition t_skeleton := t_skeleton.record.
where "'t" :=
(t_skeleton
Tezos_protocol_environment_alpha__Environment.Block_header.shell_header
'protocol_data)
and "'protocol_data" :=
(protocol_data_skeleton 'contents
Tezos_protocol_environment_alpha__Environment.Signature.t)
and "'contents" :=
(contents_skeleton Z (option Tezos_raw_protocol_alpha.Nonce_hash.t)
Tezos_protocol_environment_alpha__Environment.MBytes.t).
Definition t := 't.
Definition protocol_data := 'protocol_data.
Definition contents := 'contents.
Definition block_header := t.
Definition raw := Tezos_protocol_environment_alpha__Environment.Block_header.t.
Definition shell_header :=
Tezos_protocol_environment_alpha__Environment.Block_header.shell_header.
Parameter raw : block_header -> raw.
Parameter encoding :
Tezos_protocol_environment_alpha__Environment.Data_encoding.encoding
block_header.
Parameter raw_encoding :
Tezos_protocol_environment_alpha__Environment.Data_encoding.t raw.
Parameter contents_encoding :
Tezos_protocol_environment_alpha__Environment.Data_encoding.t contents.
Parameter unsigned_encoding :
Tezos_protocol_environment_alpha__Environment.Data_encoding.t
(Tezos_protocol_environment_alpha__Environment.Block_header.shell_header *
contents).
Parameter protocol_data_encoding :
Tezos_protocol_environment_alpha__Environment.Data_encoding.encoding
protocol_data.
Parameter shell_header_encoding :
Tezos_protocol_environment_alpha__Environment.Data_encoding.encoding
shell_header.
Parameter max_header_length : Z.
Parameter __hash_value :
block_header -> Tezos_protocol_environment_alpha__Environment.Block_hash.t.
Parameter hash_raw :
raw -> Tezos_protocol_environment_alpha__Environment.Block_hash.t.
bootstrap_storage.ml 5 errors
(*****************************************************************************)
(* *)
(* Open Source License *)
(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com> *)
(* *)
(* Permission is hereby granted, free of charge, to any person obtaining a *)
(* copy of this software and associated documentation files (the "Software"),*)
(* to deal in the Software without restriction, including without limitation *)
(* the rights to use, copy, modify, merge, publish, distribute, sublicense, *)
(* and/or sell copies of the Software, and to permit persons to whom the *)
(* Software is furnished to do so, subject to the following conditions: *)
(* *)
(* The above copyright notice and this permission notice shall be included *)
(* in all copies or substantial portions of the Software. *)
(* *)
(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*)
(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, *)
(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL *)
(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*)
(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING *)
(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER *)
(* DEALINGS IN THE SOFTWARE. *)
(* *)
(*****************************************************************************)
open Misc
let init_account ctxt
({public_key_hash; public_key; amount} : Parameters_repr.bootstrap_account)
=
let contract = Contract_repr.implicit_contract public_key_hash in
Contract_storage.credit ctxt contract amount
>>=? fun ctxt ->
match public_key with
| Some public_key ->
Contract_storage.reveal_manager_key ctxt public_key_hash public_key
>>=? fun ctxt ->
Delegate_storage.set ctxt contract (Some public_key_hash)
>>=? fun ctxt -> return ctxt
| None ->
return ctxt
let init_contract ~typecheck ctxt
({delegate; amount; script} : Parameters_repr.bootstrap_contract) =
Contract_storage.fresh_contract_from_current_nonce ctxt
>>=? fun (ctxt, contract) ->
typecheck ctxt script
>>=? fun (script, ctxt) ->
Contract_storage.originate
ctxt
contract
~balance:amount
~prepaid_bootstrap_storage:true
~script
~delegate:(Some delegate)
>>=? fun ctxt -> return ctxt
let init ctxt ~typecheck ?ramp_up_cycles ?no_reward_cycles accounts contracts =
let nonce =
Operation_hash.hash_bytes [MBytes.of_string "Un festival de GADT."]
in
let ctxt = Raw_context.init_origination_nonce ctxt nonce in
fold_left_s init_account ctxt accounts
>>=? fun ctxt ->
fold_left_s (init_contract ~typecheck) ctxt contracts
>>=? fun ctxt ->
( match no_reward_cycles with
| None ->
return ctxt
| Some cycles ->
(* Store pending ramp ups. *)
let constants = Raw_context.constants ctxt in
(* Start without reward *)
Raw_context.patch_constants ctxt (fun c ->
{
c with
block_reward = Tez_repr.zero;
endorsement_reward = Tez_repr.zero;
})
>>= fun ctxt ->
(* Store the final reward. *)
Storage.Ramp_up.Rewards.init
ctxt
(Cycle_repr.of_int32_exn (Int32.of_int cycles))
(constants.block_reward, constants.endorsement_reward) )
>>=? fun ctxt ->
match ramp_up_cycles with
| None ->
return ctxt
| Some cycles ->
(* Store pending ramp ups. *)
let constants = Raw_context.constants ctxt in
Lwt.return
Tez_repr.(constants.block_security_deposit /? Int64.of_int cycles)
>>=? fun block_step ->
Lwt.return
Tez_repr.(
constants.endorsement_security_deposit /? Int64.of_int cycles)
>>=? fun endorsement_step ->
(* Start without security_deposit *)
Raw_context.patch_constants ctxt (fun c ->
{
c with
block_security_deposit = Tez_repr.zero;
endorsement_security_deposit = Tez_repr.zero;
})
>>= fun ctxt ->
fold_left_s
(fun ctxt cycle ->
Lwt.return Tez_repr.(block_step *? Int64.of_int cycle)
>>=? fun block_security_deposit ->
Lwt.return Tez_repr.(endorsement_step *? Int64.of_int cycle)
>>=? fun endorsement_security_deposit ->
let cycle = Cycle_repr.of_int32_exn (Int32.of_int cycle) in
Storage.Ramp_up.Security_deposits.init
ctxt
cycle
(block_security_deposit, endorsement_security_deposit))
ctxt
(1 --> (cycles - 1))
>>=? fun ctxt ->
(* Store the final security deposits. *)
Storage.Ramp_up.Security_deposits.init
ctxt
(Cycle_repr.of_int32_exn (Int32.of_int cycles))
( constants.block_security_deposit,
constants.endorsement_security_deposit )
>>=? fun ctxt -> return ctxt
let cycle_end ctxt last_cycle =
let next_cycle = Cycle_repr.succ last_cycle in
Storage.Ramp_up.Rewards.get_option ctxt next_cycle
>>=? (function
| None ->
return ctxt
| Some (block_reward, endorsement_reward) ->
Storage.Ramp_up.Rewards.delete ctxt next_cycle
>>=? fun ctxt ->
Raw_context.patch_constants ctxt (fun c ->
{c with block_reward; endorsement_reward})
>>= fun ctxt -> return ctxt)
>>=? fun ctxt ->
Storage.Ramp_up.Security_deposits.get_option ctxt next_cycle
>>=? function
| None ->
return ctxt
| Some (block_security_deposit, endorsement_security_deposit) ->
Storage.Ramp_up.Security_deposits.delete ctxt next_cycle
>>=? fun ctxt ->
Raw_context.patch_constants ctxt (fun c ->
{c with block_security_deposit; endorsement_security_deposit})
>>= fun ctxt -> return ctxt
bootstrap_storage_ml.v
Require Import OCaml.OCaml.
Local Open Scope Z_scope.
Local Open Scope type_scope.
Import ListNotations.
Import Misc.
Definition init_account
(ctxt : Tezos_raw_protocol_alpha.Raw_context.t)
(function_parameter :
Tezos_raw_protocol_alpha.Parameters_repr.bootstrap_account)
: Tezos_protocol_environment_alpha__Environment.Lwt.t
(Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
Tezos_raw_protocol_alpha.Raw_context.t) :=
let '{|
Tezos_raw_protocol_alpha.Parameters_repr.bootstrap_account.public_key_hash :=
public_key_hash;
Tezos_raw_protocol_alpha.Parameters_repr.bootstrap_account.public_key :=
public_key;
Tezos_raw_protocol_alpha.Parameters_repr.bootstrap_account.amount :=
amount
|} := function_parameter in
let contract := Contract_repr.implicit_contract public_key_hash in
op_gtgteqquestion (Contract_storage.credit ctxt contract amount)
(fun ctxt =>
match public_key with
| Some public_key =>
op_gtgteqquestion
(Contract_storage.reveal_manager_key ctxt public_key_hash public_key)
(fun ctxt =>
op_gtgteqquestion
(Delegate_storage.set ctxt contract (Some public_key_hash))
(fun ctxt => __return ctxt))
| None => __return ctxt
end).
Definition init_contract
(typecheck :
Tezos_raw_protocol_alpha.Raw_context.t ->
Tezos_raw_protocol_alpha.Script_repr.t ->
Tezos_protocol_environment_alpha__Environment.Lwt.t
(Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
((Tezos_raw_protocol_alpha.Script_repr.t *
option Tezos_raw_protocol_alpha.Contract_storage.big_map_diff) *
Tezos_raw_protocol_alpha.Raw_context.t)))
(ctxt : Tezos_raw_protocol_alpha.Raw_context.t)
(function_parameter :
Tezos_raw_protocol_alpha.Parameters_repr.bootstrap_contract)
: Tezos_protocol_environment_alpha__Environment.Lwt.t
(Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
Tezos_raw_protocol_alpha.Raw_context.t) :=
let '{|
Tezos_raw_protocol_alpha.Parameters_repr.bootstrap_contract.delegate :=
delegate;
Tezos_raw_protocol_alpha.Parameters_repr.bootstrap_contract.amount :=
amount;
Tezos_raw_protocol_alpha.Parameters_repr.bootstrap_contract.script :=
script
|} := function_parameter in
op_gtgteqquestion (Contract_storage.fresh_contract_from_current_nonce ctxt)
(fun function_parameter =>
let '(ctxt, contract) := function_parameter in
op_gtgteqquestion (typecheck ctxt script)
(fun function_parameter =>
let '(script, ctxt) := function_parameter in
op_gtgteqquestion
(Contract_storage.originate ctxt (Some true) contract amount script
(Some delegate)) (fun ctxt => __return ctxt))).
Definition init
(ctxt : Tezos_raw_protocol_alpha.Raw_context.t)
(typecheck :
Tezos_raw_protocol_alpha.Raw_context.t ->
Tezos_raw_protocol_alpha.Script_repr.t ->
Tezos_protocol_environment_alpha__Environment.Lwt.t
(Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
((Tezos_raw_protocol_alpha.Script_repr.t *
option Tezos_raw_protocol_alpha.Contract_storage.big_map_diff) *
Tezos_raw_protocol_alpha.Raw_context.t))) (ramp_up_cycles : option Z)
(no_reward_cycles : option Z)
(accounts : list Tezos_raw_protocol_alpha.Parameters_repr.bootstrap_account)
(contracts : list Tezos_raw_protocol_alpha.Parameters_repr.bootstrap_contract)
: Tezos_protocol_environment_alpha__Environment.Lwt.t
(Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
Tezos_raw_protocol_alpha.Raw_context.t) :=
let nonce :=
Operation_hash.hash_bytes None
(cons (MBytes.of_string "Un festival de GADT." % string) []) in
let ctxt := Raw_context.init_origination_nonce ctxt nonce in
op_gtgteqquestion (fold_left_s init_account ctxt accounts)
(fun ctxt =>
op_gtgteqquestion (fold_left_s (init_contract typecheck) ctxt contracts)
(fun ctxt =>
op_gtgteqquestion
match no_reward_cycles with
| None => __return ctxt
| Some cycles =>
let constants := Raw_context.constants ctxt in
op_gtgteq
(Raw_context.patch_constants ctxt
(fun c =>
(* ❌ Record substitution not handled *)
record_substitution))
(fun ctxt =>
Storage.Ramp_up.Rewards.init ctxt
(Cycle_repr.of_int32_exn (Int32.of_int cycles))
((Tezos_raw_protocol_alpha.Constants_repr.parametric.block_reward
constants),
(Tezos_raw_protocol_alpha.Constants_repr.parametric.endorsement_reward
constants)))
end
(fun ctxt =>
match ramp_up_cycles with
| None => __return ctxt
| Some cycles =>
let constants := Raw_context.constants ctxt in
op_gtgteqquestion
(Lwt.__return
(op_divquestion
(Tezos_raw_protocol_alpha.Constants_repr.parametric.block_security_deposit
constants) (Int64.of_int cycles)))
(fun block_step =>
op_gtgteqquestion
(Lwt.__return
(op_divquestion
(Tezos_raw_protocol_alpha.Constants_repr.parametric.endorsement_security_deposit
constants) (Int64.of_int cycles)))
(fun endorsement_step =>
op_gtgteq
(Raw_context.patch_constants ctxt
(fun c =>
(* ❌ Record substitution not handled *)
record_substitution))
(fun ctxt =>
op_gtgteqquestion
(fold_left_s
(fun ctxt =>
fun cycle =>
op_gtgteqquestion
(Lwt.__return
(op_starquestion block_step
(Int64.of_int cycle)))
(fun block_security_deposit =>
op_gtgteqquestion
(Lwt.__return
(op_starquestion endorsement_step
(Int64.of_int cycle)))
(fun endorsement_security_deposit =>
let cycle :=
Cycle_repr.of_int32_exn
(Int32.of_int cycle) in
Storage.Ramp_up.Security_deposits.init
ctxt cycle
(block_security_deposit,
endorsement_security_deposit))))
ctxt (op_minusminusgt 1 (op_minus cycles 1)))
(fun ctxt =>
op_gtgteqquestion
(Storage.Ramp_up.Security_deposits.init ctxt
(Cycle_repr.of_int32_exn
(Int32.of_int cycles))
((Tezos_raw_protocol_alpha.Constants_repr.parametric.block_security_deposit
constants),
(Tezos_raw_protocol_alpha.Constants_repr.parametric.endorsement_security_deposit
constants))) (fun ctxt => __return ctxt)))))
end))).
Definition cycle_end
(ctxt : Tezos_raw_protocol_alpha.Storage.Ramp_up.Rewards.context)
(last_cycle : Tezos_raw_protocol_alpha.Cycle_repr.cycle)
: Tezos_protocol_environment_alpha__Environment.Lwt.t
(Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
Tezos_raw_protocol_alpha.Storage.Ramp_up.Rewards.context) :=
let next_cycle := Cycle_repr.succ last_cycle in
op_gtgteqquestion
(op_gtgteqquestion (Storage.Ramp_up.Rewards.get_option ctxt next_cycle)
(fun function_parameter =>
match function_parameter with
| None => __return ctxt
| Some (block_reward, endorsement_reward) =>
op_gtgteqquestion (Storage.Ramp_up.Rewards.delete ctxt next_cycle)
(fun ctxt =>
op_gtgteq
(Raw_context.patch_constants ctxt
(fun c =>
(* ❌ Record substitution not handled *)
record_substitution)) (fun ctxt => __return ctxt))
end))
(fun ctxt =>
op_gtgteqquestion
(Storage.Ramp_up.Security_deposits.get_option ctxt next_cycle)
(fun function_parameter =>
match function_parameter with
| None => __return ctxt
| Some (block_security_deposit, endorsement_security_deposit) =>
op_gtgteqquestion
(Storage.Ramp_up.Security_deposits.delete ctxt next_cycle)
(fun ctxt =>
op_gtgteq
(Raw_context.patch_constants ctxt
(fun c =>
(* ❌ Record substitution not handled *)
record_substitution)) (fun ctxt => __return ctxt))
end)).
bootstrap_storage.mli 1 error
(*****************************************************************************)
(* *)
(* Open Source License *)
(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com> *)
(* *)
(* Permission is hereby granted, free of charge, to any person obtaining a *)
(* copy of this software and associated documentation files (the "Software"),*)
(* to deal in the Software without restriction, including without limitation *)
(* the rights to use, copy, modify, merge, publish, distribute, sublicense, *)
(* and/or sell copies of the Software, and to permit persons to whom the *)
(* Software is furnished to do so, subject to the following conditions: *)
(* *)
(* The above copyright notice and this permission notice shall be included *)
(* in all copies or substantial portions of the Software. *)
(* *)
(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*)
(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, *)
(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL *)
(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*)
(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING *)
(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER *)
(* DEALINGS IN THE SOFTWARE. *)
(* *)
(*****************************************************************************)
val init :
Raw_context.t ->
typecheck:(Raw_context.t ->
Script_repr.t ->
( (Script_repr.t * Contract_storage.big_map_diff option)
* Raw_context.t )
tzresult
Lwt.t) ->
?ramp_up_cycles:int ->
?no_reward_cycles:int ->
Parameters_repr.bootstrap_account list ->
Parameters_repr.bootstrap_contract list ->
Raw_context.t tzresult Lwt.t
val cycle_end : Raw_context.t -> Cycle_repr.t -> Raw_context.t tzresult Lwt.t
bootstrap_storage_mli.v
Require Import OCaml.OCaml.
Local Open Scope Z_scope.
Local Open Scope type_scope.
Import ListNotations.
Parameter init :
Tezos_raw_protocol_alpha.Raw_context.t ->
(Tezos_raw_protocol_alpha.Raw_context.t ->
Tezos_raw_protocol_alpha.Script_repr.t ->
Tezos_protocol_environment_alpha__Environment.Lwt.t
(Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
((Tezos_raw_protocol_alpha.Script_repr.t *
option Tezos_raw_protocol_alpha.Contract_storage.big_map_diff) *
Tezos_raw_protocol_alpha.Raw_context.t))) -> option Z -> option Z ->
list Tezos_raw_protocol_alpha.Parameters_repr.bootstrap_account ->
list Tezos_raw_protocol_alpha.Parameters_repr.bootstrap_contract ->
Tezos_protocol_environment_alpha__Environment.Lwt.t
(Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
Tezos_raw_protocol_alpha.Raw_context.t).
Parameter cycle_end :
Tezos_raw_protocol_alpha.Raw_context.t ->
Tezos_raw_protocol_alpha.Cycle_repr.t ->
Tezos_protocol_environment_alpha__Environment.Lwt.t
(Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
Tezos_raw_protocol_alpha.Raw_context.t).
commitment_repr.ml 1 error
(*****************************************************************************)
(* *)
(* Open Source License *)
(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com> *)
(* *)
(* Permission is hereby granted, free of charge, to any person obtaining a *)
(* copy of this software and associated documentation files (the "Software"),*)
(* to deal in the Software without restriction, including without limitation *)
(* the rights to use, copy, modify, merge, publish, distribute, sublicense, *)
(* and/or sell copies of the Software, and to permit persons to whom the *)
(* Software is furnished to do so, subject to the following conditions: *)
(* *)
(* The above copyright notice and this permission notice shall be included *)
(* in all copies or substantial portions of the Software. *)
(* *)
(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*)
(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, *)
(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL *)
(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*)
(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING *)
(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER *)
(* DEALINGS IN THE SOFTWARE. *)
(* *)
(*****************************************************************************)
type t = {
blinded_public_key_hash : Blinded_public_key_hash.t;
amount : Tez_repr.t;
}
let encoding =
let open Data_encoding in
conv
(fun {blinded_public_key_hash; amount} ->
(blinded_public_key_hash, amount))
(fun (blinded_public_key_hash, amount) ->
{blinded_public_key_hash; amount})
(tup2 Blinded_public_key_hash.encoding Tez_repr.encoding)
commitment_repr_ml.v
Require Import OCaml.OCaml.
Local Open Scope Z_scope.
Local Open Scope type_scope.
Import ListNotations.
Module t.
Record record := {
blinded_public_key_hash : Tezos_raw_protocol_alpha.Blinded_public_key_hash.t;
amount : Tezos_raw_protocol_alpha.Tez_repr.t }.
End t.
Definition t := t.record.
Definition encoding
: Tezos_protocol_environment_alpha__Environment.Data_encoding.encoding t :=
conv
(fun function_parameter =>
let '{|
t.blinded_public_key_hash := blinded_public_key_hash;
t.amount := amount
|} := function_parameter in
(blinded_public_key_hash, amount))
(fun function_parameter =>
let '(blinded_public_key_hash, amount) := function_parameter in
{| t.blinded_public_key_hash := blinded_public_key_hash;
t.amount := amount |}) None
(tup2 Blinded_public_key_hash.encoding Tez_repr.encoding).
commitment_repr.mli 1 error
(*****************************************************************************)
(* *)
(* Open Source License *)
(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com> *)
(* *)
(* Permission is hereby granted, free of charge, to any person obtaining a *)
(* copy of this software and associated documentation files (the "Software"),*)
(* to deal in the Software without restriction, including without limitation *)
(* the rights to use, copy, modify, merge, publish, distribute, sublicense, *)
(* and/or sell copies of the Software, and to permit persons to whom the *)
(* Software is furnished to do so, subject to the following conditions: *)
(* *)
(* The above copyright notice and this permission notice shall be included *)
(* in all copies or substantial portions of the Software. *)
(* *)
(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*)
(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, *)
(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL *)
(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*)
(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING *)
(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER *)
(* DEALINGS IN THE SOFTWARE. *)
(* *)
(*****************************************************************************)
type t = {
blinded_public_key_hash : Blinded_public_key_hash.t;
amount : Tez_repr.t;
}
val encoding : t Data_encoding.t
commitment_repr_mli.v
Require Import OCaml.OCaml.
Local Open Scope Z_scope.
Local Open Scope type_scope.
Import ListNotations.
Module t.
Record record := {
blinded_public_key_hash : Tezos_raw_protocol_alpha.Blinded_public_key_hash.t;
amount : Tezos_raw_protocol_alpha.Tez_repr.t }.
End t.
Definition t := t.record.
Parameter encoding :
Tezos_protocol_environment_alpha__Environment.Data_encoding.t t.
commitment_storage.ml 1 error
(*****************************************************************************)
(* *)
(* Open Source License *)
(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com> *)
(* *)
(* Permission is hereby granted, free of charge, to any person obtaining a *)
(* copy of this software and associated documentation files (the "Software"),*)
(* to deal in the Software without restriction, including without limitation *)
(* the rights to use, copy, modify, merge, publish, distribute, sublicense, *)
(* and/or sell copies of the Software, and to permit persons to whom the *)
(* Software is furnished to do so, subject to the following conditions: *)
(* *)
(* The above copyright notice and this permission notice shall be included *)
(* in all copies or substantial portions of the Software. *)
(* *)
(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*)
(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, *)
(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL *)
(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*)
(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING *)
(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER *)
(* DEALINGS IN THE SOFTWARE. *)
(* *)
(*****************************************************************************)
let get_opt = Storage.Commitments.get_option
let delete = Storage.Commitments.delete
let init ctxt commitments =
let init_commitment ctxt Commitment_repr.{blinded_public_key_hash; amount} =
Storage.Commitments.init ctxt blinded_public_key_hash amount
in
fold_left_s init_commitment ctxt commitments >>=? fun ctxt -> return ctxt
commitment_storage_ml.v
Require Import OCaml.OCaml.
Local Open Scope Z_scope.
Local Open Scope type_scope.
Import ListNotations.
Definition get_opt
: Tezos_raw_protocol_alpha.Storage.Commitments.context ->
Tezos_raw_protocol_alpha.Storage.Commitments.key ->
Tezos_protocol_environment_alpha__Environment.Lwt.t
(Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
(option Tezos_raw_protocol_alpha.Storage.Commitments.value)) :=
Storage.Commitments.get_option.
Definition delete
: Tezos_raw_protocol_alpha.Storage.Commitments.context ->
Tezos_raw_protocol_alpha.Storage.Commitments.key ->
Tezos_protocol_environment_alpha__Environment.Lwt.t
(Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
Tezos_raw_protocol_alpha.Raw_context.t) := Storage.Commitments.delete.
Definition init
(ctxt : Tezos_raw_protocol_alpha.Storage.Commitments.context)
(commitments : list Tezos_raw_protocol_alpha.Commitment_repr.t)
: Tezos_protocol_environment_alpha__Environment.Lwt.t
(Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
Tezos_raw_protocol_alpha.Storage.Commitments.context) :=
let init_commitment
(ctxt : Tezos_raw_protocol_alpha.Storage.Commitments.context)
(function_parameter : Tezos_raw_protocol_alpha.Commitment_repr.t)
: Tezos_protocol_environment_alpha__Environment.Lwt.t
(Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
Tezos_raw_protocol_alpha.Raw_context.t) :=
let '{|
Tezos_raw_protocol_alpha.Commitment_repr.t.blinded_public_key_hash :=
blinded_public_key_hash;
Tezos_raw_protocol_alpha.Commitment_repr.t.amount := amount
|} := function_parameter in
Storage.Commitments.init ctxt blinded_public_key_hash amount in
op_gtgteqquestion (fold_left_s init_commitment ctxt commitments)
(fun ctxt => __return ctxt).
commitment_storage.mli 1 error
(*****************************************************************************) (* *) (* Open Source License *) (* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com> *) (* *) (* Permission is hereby granted, free of charge, to any person obtaining a *) (* copy of this software and associated documentation files (the "Software"),*) (* to deal in the Software without restriction, including without limitation *) (* the rights to use, copy, modify, merge, publish, distribute, sublicense, *) (* and/or sell copies of the Software, and to permit persons to whom the *) (* Software is furnished to do so, subject to the following conditions: *) (* *) (* The above copyright notice and this permission notice shall be included *) (* in all copies or substantial portions of the Software. *) (* *) (* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*) (* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, *) (* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL *) (* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*) (* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING *) (* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER *) (* DEALINGS IN THE SOFTWARE. *) (* *) (*****************************************************************************) val init : Raw_context.t -> Commitment_repr.t list -> Raw_context.t tzresult Lwt.t val get_opt : Raw_context.t -> Blinded_public_key_hash.t -> Tez_repr.t option tzresult Lwt.t val delete : Raw_context.t -> Blinded_public_key_hash.t -> Raw_context.t tzresult Lwt.t
commitment_storage_mli.v
Require Import OCaml.OCaml.
Local Open Scope Z_scope.
Local Open Scope type_scope.
Import ListNotations.
Parameter init :
Tezos_raw_protocol_alpha.Raw_context.t ->
list Tezos_raw_protocol_alpha.Commitment_repr.t ->
Tezos_protocol_environment_alpha__Environment.Lwt.t
(Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
Tezos_raw_protocol_alpha.Raw_context.t).
Parameter get_opt :
Tezos_raw_protocol_alpha.Raw_context.t ->
Tezos_raw_protocol_alpha.Blinded_public_key_hash.t ->
Tezos_protocol_environment_alpha__Environment.Lwt.t
(Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
(option Tezos_raw_protocol_alpha.Tez_repr.t)).
Parameter delete :
Tezos_raw_protocol_alpha.Raw_context.t ->
Tezos_raw_protocol_alpha.Blinded_public_key_hash.t ->
Tezos_protocol_environment_alpha__Environment.Lwt.t
(Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
Tezos_raw_protocol_alpha.Raw_context.t).
constants_repr.ml 1 error
(*****************************************************************************)
(* *)
(* Open Source License *)
(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com> *)
(* *)
(* Permission is hereby granted, free of charge, to any person obtaining a *)
(* copy of this software and associated documentation files (the "Software"),*)
(* to deal in the Software without restriction, including without limitation *)
(* the rights to use, copy, modify, merge, publish, distribute, sublicense, *)
(* and/or sell copies of the Software, and to permit persons to whom the *)
(* Software is furnished to do so, subject to the following conditions: *)
(* *)
(* The above copyright notice and this permission notice shall be included *)
(* in all copies or substantial portions of the Software. *)
(* *)
(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*)
(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, *)
(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL *)
(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*)
(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING *)
(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER *)
(* DEALINGS IN THE SOFTWARE. *)
(* *)
(*****************************************************************************)
let version_number_004 = "\000"
let version_number = "\001"
let proof_of_work_nonce_size = 8
let nonce_length = 32
let max_revelations_per_block = 32
let max_proposals_per_delegate = 20
let max_operation_data_length = 16 * 1024 (* 16kB *)
type fixed = {
proof_of_work_nonce_size : int;
nonce_length : int;
max_revelations_per_block : int;
max_operation_data_length : int;
max_proposals_per_delegate : int;
}
let fixed_encoding =
let open Data_encoding in
conv
(fun c ->
( c.proof_of_work_nonce_size,
c.nonce_length,
c.max_revelations_per_block,
c.max_operation_data_length,
c.max_proposals_per_delegate ))
(fun ( proof_of_work_nonce_size,
nonce_length,
max_revelations_per_block,
max_operation_data_length,
max_proposals_per_delegate ) ->
{
proof_of_work_nonce_size;
nonce_length;
max_revelations_per_block;
max_operation_data_length;
max_proposals_per_delegate;
})
(obj5
(req "proof_of_work_nonce_size" uint8)
(req "nonce_length" uint8)
(req "max_revelations_per_block" uint8)
(req "max_operation_data_length" int31)
(req "max_proposals_per_delegate" uint8))
let fixed =
{
proof_of_work_nonce_size;
nonce_length;
max_revelations_per_block;
max_operation_data_length;
max_proposals_per_delegate;
}
type parametric = {
preserved_cycles : int;
blocks_per_cycle : int32;
blocks_per_commitment : int32;
blocks_per_roll_snapshot : int32;
blocks_per_voting_period : int32;
time_between_blocks : Period_repr.t list;
endorsers_per_block : int;
hard_gas_limit_per_operation : Z.t;
hard_gas_limit_per_block : Z.t;
proof_of_work_threshold : int64;
tokens_per_roll : Tez_repr.t;
michelson_maximum_type_size : int;
seed_nonce_revelation_tip : Tez_repr.t;
origination_size : int;
block_security_deposit : Tez_repr.t;
endorsement_security_deposit : Tez_repr.t;
block_reward : Tez_repr.t;
endorsement_reward : Tez_repr.t;
cost_per_byte : Tez_repr.t;
hard_storage_limit_per_operation : Z.t;
test_chain_duration : int64;
(* in seconds *)
quorum_min : int32;
quorum_max : int32;
min_proposal_quorum : int32;
initial_endorsers : int;
delay_per_missing_endorsement : Period_repr.t;
}
let parametric_encoding =
let open Data_encoding in
conv
(fun c ->
( ( c.preserved_cycles,
c.blocks_per_cycle,
c.blocks_per_commitment,
c.blocks_per_roll_snapshot,
c.blocks_per_voting_period,
c.time_between_blocks,
c.endorsers_per_block,
c.hard_gas_limit_per_operation,
c.hard_gas_limit_per_block ),
( ( c.proof_of_work_threshold,
c.tokens_per_roll,
c.michelson_maximum_type_size,
c.seed_nonce_revelation_tip,
c.origination_size,
c.block_security_deposit,
c.endorsement_security_deposit,
c.block_reward ),
( c.endorsement_reward,
c.cost_per_byte,
c.hard_storage_limit_per_operation,
c.test_chain_duration,
c.quorum_min,
c.quorum_max,
c.min_proposal_quorum,
c.initial_endorsers,
c.delay_per_missing_endorsement ) ) ))
(fun ( ( preserved_cycles,
blocks_per_cycle,
blocks_per_commitment,
blocks_per_roll_snapshot,
blocks_per_voting_period,
time_between_blocks,
endorsers_per_block,
hard_gas_limit_per_operation,
hard_gas_limit_per_block ),
( ( proof_of_work_threshold,
tokens_per_roll,
michelson_maximum_type_size,
seed_nonce_revelation_tip,
origination_size,
block_security_deposit,
endorsement_security_deposit,
block_reward ),
( endorsement_reward,
cost_per_byte,
hard_storage_limit_per_operation,
test_chain_duration,
quorum_min,
quorum_max,
min_proposal_quorum,
initial_endorsers,
delay_per_missing_endorsement ) ) ) ->
{
preserved_cycles;
blocks_per_cycle;
blocks_per_commitment;
blocks_per_roll_snapshot;
blocks_per_voting_period;
time_between_blocks;
endorsers_per_block;
hard_gas_limit_per_operation;
hard_gas_limit_per_block;
proof_of_work_threshold;
tokens_per_roll;
michelson_maximum_type_size;
seed_nonce_revelation_tip;
origination_size;
block_security_deposit;
endorsement_security_deposit;
block_reward;
endorsement_reward;
cost_per_byte;
hard_storage_limit_per_operation;
test_chain_duration;
quorum_min;
quorum_max;
min_proposal_quorum;
initial_endorsers;
delay_per_missing_endorsement;
})
(merge_objs
(obj9
(req "preserved_cycles" uint8)
(req "blocks_per_cycle" int32)
(req "blocks_per_commitment" int32)
(req "blocks_per_roll_snapshot" int32)
(req "blocks_per_voting_period" int32)
(req "time_between_blocks" (list Period_repr.encoding))
(req "endorsers_per_block" uint16)
(req "hard_gas_limit_per_operation" z)
(req "hard_gas_limit_per_block" z))
(merge_objs
(obj8
(req "proof_of_work_threshold" int64)
(req "tokens_per_roll" Tez_repr.encoding)
(req "michelson_maximum_type_size" uint16)
(req "seed_nonce_revelation_tip" Tez_repr.encoding)
(req "origination_size" int31)
(req "block_security_deposit" Tez_repr.encoding)
(req "endorsement_security_deposit" Tez_repr.encoding)
(req "block_reward" Tez_repr.encoding))
(obj9
(req "endorsement_reward" Tez_repr.encoding)
(req "cost_per_byte" Tez_repr.encoding)
(req "hard_storage_limit_per_operation" z)
(req "test_chain_duration" int64)
(req "quorum_min" int32)
(req "quorum_max" int32)
(req "min_proposal_quorum" int32)
(req "initial_endorsers" uint16)
(req "delay_per_missing_endorsement" Period_repr.encoding))))
type t = {fixed : fixed; parametric : parametric}
let encoding =
let open Data_encoding in
conv
(fun {fixed; parametric} -> (fixed, parametric))
(fun (fixed, parametric) -> {fixed; parametric})
(merge_objs fixed_encoding parametric_encoding)
constants_repr_ml.v
Require Import OCaml.OCaml. Local Open Scope Z_scope. Local Open Scope type_scope. Import ListNotations. Definition version_number_004 : string := "